Reverse order, no args from hamlet

This commit is contained in:
Michael Snoyman 2010-05-08 23:34:31 +03:00
parent 7a4f1ad6de
commit db5b82f74d
5 changed files with 54 additions and 58 deletions

View File

@ -51,23 +51,23 @@ xmlns :: AtomFeed url -> HtmlContent
xmlns _ = cs "http://www.w3.org/2005/Atom" xmlns _ = cs "http://www.w3.org/2005/Atom"
template :: AtomFeed url -> Hamlet url IO () template :: AtomFeed url -> Hamlet url IO ()
template = [$hamlet| template arg = [$hamlet|
%feed!xmlns=$.xmlns$ %feed!xmlns=$xmlns.arg$
%title $.atomTitle.cs$ %title $cs.atomTitle.arg$
%link!rel=self!href=@.atomLinkSelf@ %link!rel=self!href=@atomLinkSelf.arg@
%link!href=@.atomLinkHome@ %link!href=@atomLinkHome.arg@
%updated $.atomUpdated.formatW3.cs$ %updated $cs.formatW3.atomUpdated.arg$
%id @.atomLinkHome@ %id @atomLinkHome.arg@
$forall .atomEntries entry $forall atomEntries.arg entry
^entry.entryTemplate^ ^entryTemplate.entry^
|] |]
entryTemplate :: AtomFeedEntry url -> Hamlet url IO () entryTemplate :: AtomFeedEntry url -> Hamlet url IO ()
entryTemplate = [$hamlet| entryTemplate arg = [$hamlet|
%entry %entry
%id @.atomEntryLink@ %id @atomEntryLink.arg@
%link!href=@.atomEntryLink@ %link!href=@atomEntryLink.arg@
%updated $.atomEntryUpdated.formatW3.cs$ %updated $cs.formatW3.atomEntryUpdated.arg$
%title $.atomEntryTitle.cs$ %title $cs.atomEntryTitle.arg$
%content!type=html $.atomEntryContent.cdata$ %content!type=html $cdata.atomEntryContent.arg$
|] |]

View File

@ -92,15 +92,14 @@ getOpenIdR = do
(x:_) -> addCookie destCookieTimeout destCookieName x (x:_) -> addCookie destCookieTimeout destCookieName x
rtom <- getRouteToMaster rtom <- getRouteToMaster
let message = cs <$> (listToMaybe $ getParams rr "message") let message = cs <$> (listToMaybe $ getParams rr "message")
let urlForward = rtom OpenIdForward
applyLayout "Log in via OpenID" $ [$hamlet| applyLayout "Log in via OpenID" $ [$hamlet|
$maybe message msg $maybe message msg
%p.message $msg$ %p.message $msg$
%form!method=get!action=@urlForward@ %form!method=get!action=@rtom.OpenIdForward@
%label!for=openid OpenID: %label!for=openid OpenID:
%input#openid!type=text!name=openid %input#openid!type=text!name=openid
%input!type=submit!value=Login %input!type=submit!value=Login
|] () |]
getOpenIdForward :: GHandler Auth master () getOpenIdForward :: GHandler Auth master ()
getOpenIdForward = do getOpenIdForward = do
@ -175,13 +174,13 @@ getCheck = do
let arg = (cs $ fromMaybe "" ident, cs $ fromMaybe "" dn) let arg = (cs $ fromMaybe "" ident, cs $ fromMaybe "" dn)
applyLayoutJson "Authentication Status" arg html json applyLayoutJson "Authentication Status" arg html json
where where
html = [$hamlet| html (x, y) = [$hamlet|
%h1 Authentication Status %h1 Authentication Status
%dl %dl
%dt identifier %dt identifier
%dd $.fst$ %dd $x$
%dt displayName %dt displayName
%dd $.snd$ %dd $y$
|] |]
json (ident, dn) = json (ident, dn) =
jsonMap [ ("ident", jsonScalar ident) jsonMap [ ("ident", jsonScalar ident)

View File

@ -71,11 +71,11 @@ getRegisterR = do
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
applyLayout "Register a new account" $ [$hamlet| applyLayout "Register a new account" $ [$hamlet|
%p Enter your e-mail address below, and a confirmation e-mail will be sent to you. %p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
%form!method=post!action=@RegisterR.toMaster@ %form!method=post!action=@toMaster.RegisterR@
%label!for=email E-mail %label!for=email E-mail
%input#email!type=email!name=email!width=150 %input#email!type=email!name=email!width=150
%input!type=submit!value=Register %input!type=submit!value=Register
|] () |]
postRegisterR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml postRegisterR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml
postRegisterR = do postRegisterR = do
@ -93,8 +93,8 @@ postRegisterR = do
let verUrl = render $ VerifyR lid verKey let verUrl = render $ VerifyR lid verKey
liftIO $ sendVerifyEmail y email verKey verUrl liftIO $ sendVerifyEmail y email verKey verUrl
applyLayout "Confirmation e-mail sent" $ [$hamlet| applyLayout "Confirmation e-mail sent" $ [$hamlet|
%p A confirmation e-mail has been sent to $email.cs$. %p A confirmation e-mail has been sent to $cs.email$.
|] () |]
checkEmail :: Form ParamValue -> Form ParamValue checkEmail :: Form ParamValue -> Form ParamValue
checkEmail = notEmpty -- FIXME checkEmail = notEmpty -- FIXME
@ -113,7 +113,7 @@ getVerifyR lid key = do
redirect RedirectTemporary $ toMaster PasswordR redirect RedirectTemporary $ toMaster PasswordR
_ -> applyLayout "Invalid verification key" $ [$hamlet| _ -> applyLayout "Invalid verification key" $ [$hamlet|
%p I'm sorry, but that was an invalid verification key. %p I'm sorry, but that was an invalid verification key.
|] () |]
messageKey :: String messageKey :: String
messageKey = "MESSAGE" messageKey = "MESSAGE"
@ -136,8 +136,8 @@ $maybe msg ms
%p.message $ms$ %p.message $ms$
%p Please log in to your account. %p Please log in to your account.
%p %p
%a!href=@RegisterR.toMaster@ I don't have an account %a!href=@toMaster.RegisterR@ I don't have an account
%form!method=post!action=@LoginR.toMaster@ %form!method=post!action=@toMaster.LoginR@
%table %table
%tr %tr
%th E-mail %th E-mail
@ -150,7 +150,7 @@ $maybe msg ms
%tr %tr
%td!colspan=2 %td!colspan=2
%input!type=submit!value=Login %input!type=submit!value=Login
|] () |]
postLoginR :: YesodEmailAuth master => GHandler EmailAuth master () postLoginR :: YesodEmailAuth master => GHandler EmailAuth master ()
postLoginR = do postLoginR = do
@ -181,11 +181,11 @@ getPasswordR = do
setMessage "You must be logged in to set a password" setMessage "You must be logged in to set a password"
redirect RedirectTemporary $ toMaster LoginR redirect RedirectTemporary $ toMaster LoginR
msg <- getMessage msg <- getMessage
applyLayout "Set password" $ [$hamlet| applyLayout "Set password" [$hamlet|
$maybe msg ms $maybe msg ms
%p.message $ms$ %p.message $ms$
%h3 Set a new password %h3 Set a new password
%form!method=post!action=@PasswordR.toMaster@ %form!method=post!action=@toMaster.PasswordR@
%table %table
%tr %tr
%th New password %th New password
@ -198,7 +198,7 @@ $maybe msg ms
%tr %tr
%td!colspan=2 %td!colspan=2
%input!type=submit!value=Submit %input!type=submit!value=Submit
|] () |]
postPasswordR :: YesodEmailAuth master => GHandler EmailAuth master () postPasswordR :: YesodEmailAuth master => GHandler EmailAuth master ()
postPasswordR = do postPasswordR = do

View File

@ -51,14 +51,14 @@ sitemapNS :: HtmlContent
sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9" sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9"
template :: [SitemapUrl url] -> Hamlet url IO () template :: [SitemapUrl url] -> Hamlet url IO ()
template = [$hamlet| template urls = [$hamlet|
%urlset!xmlns=$sitemapNS$ %urlset!xmlns=$sitemapNS$
$forall .id url $forall urls url
%url %url
%loc @url.sitemapLoc@ %loc @sitemapLoc.url@
%lastmod $url.sitemapLastMod.formatW3.cs$ %lastmod $cs.formatW3.sitemapLastMod.url$
%changefreq $url.sitemapChangeFreq.showFreq.cs$ %changefreq $cs.showFreq.sitemapChangeFreq.url$
%priority $url.priority.show.cs$ %priority $cs.show.priority.url$
|] |]
sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml

View File

@ -17,7 +17,6 @@ import Yesod.Request
import Yesod.Hamlet import Yesod.Hamlet
import Yesod.Handler import Yesod.Handler
import Data.Convertible.Text import Data.Convertible.Text
import Control.Arrow ((***))
import Network.Wai.Middleware.ClientSession import Network.Wai.Middleware.ClientSession
import qualified Network.Wai as W import qualified Network.Wai as W
import Yesod.Json import Yesod.Json
@ -63,15 +62,15 @@ class YesodSite a => Yesod a where
-- | Applies some form of layout to the contents of a page. -- | Applies some form of layout to the contents of a page.
defaultLayout :: PageContent (Routes a) -> GHandler sub a Content defaultLayout :: PageContent (Routes a) -> GHandler sub a Content
defaultLayout p = hamletToContent $ [$hamlet| defaultLayout p = hamletToContent [$hamlet|
!!! !!!
%html %html
%head %head
%title $p.pageTitle$ %title $pageTitle.p$
^p.pageHead^ ^pageHead.p^
%body %body
^p.pageBody^ ^pageBody.p^
|] () |]
-- | Gets called at the beginning of each request. Useful for logging. -- | Gets called at the beginning of each request. Useful for logging.
onRequest :: a -> Request -> IO () onRequest :: a -> Request -> IO ()
@ -126,30 +125,28 @@ defaultErrorHandler NotFound = do
r <- waiRequest r <- waiRequest
applyLayout' "Not Found" $ [$hamlet| applyLayout' "Not Found" $ [$hamlet|
%h1 Not Found %h1 Not Found
%p $.helper$ %p $Unencoded.cs.pathInfo.r$
|] r |]
where where
helper = Unencoded . cs . W.pathInfo pathInfo = W.pathInfo
defaultErrorHandler PermissionDenied = defaultErrorHandler PermissionDenied =
applyLayout' "Permission Denied" $ [$hamlet| applyLayout' "Permission Denied" $ [$hamlet|
%h1 Permission denied|] () %h1 Permission denied|]
defaultErrorHandler (InvalidArgs ia) = defaultErrorHandler (InvalidArgs ia) =
applyLayout' "Invalid Arguments" $ [$hamlet| applyLayout' "Invalid Arguments" $ [$hamlet|
%h1 Invalid Arguments %h1 Invalid Arguments
%dl %dl
$forall ias pair $forall ia pair
%dt $pair.fst$ %dt $cs.fst.pair$
%dd $pair.snd$ %dd $cs.snd.pair$
|] () |]
where
ias _ = map (cs *** cs) ia
defaultErrorHandler (InternalError e) = defaultErrorHandler (InternalError e) =
applyLayout' "Internal Server Error" $ [$hamlet| applyLayout' "Internal Server Error" $ [$hamlet|
%h1 Internal Server Error %h1 Internal Server Error
%p $e.cs$ %p $cs.e$
|] () |]
defaultErrorHandler (BadMethod m) = defaultErrorHandler (BadMethod m) =
applyLayout' "Bad Method" $ [$hamlet| applyLayout' "Bad Method" $ [$hamlet|
%h1 Method Not Supported %h1 Method Not Supported
%p Method "$m.cs$" not supported %p Method "$cs.m$" not supported
|] () |]