diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 378315c2..4bcd6b0f 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/Yesod/Helpers/AtomFeed.hs @@ -51,23 +51,23 @@ xmlns :: AtomFeed url -> HtmlContent xmlns _ = cs "http://www.w3.org/2005/Atom" template :: AtomFeed url -> Hamlet url IO () -template = [$hamlet| -%feed!xmlns=$.xmlns$ - %title $.atomTitle.cs$ - %link!rel=self!href=@.atomLinkSelf@ - %link!href=@.atomLinkHome@ - %updated $.atomUpdated.formatW3.cs$ - %id @.atomLinkHome@ - $forall .atomEntries entry - ^entry.entryTemplate^ +template arg = [$hamlet| +%feed!xmlns=$xmlns.arg$ + %title $cs.atomTitle.arg$ + %link!rel=self!href=@atomLinkSelf.arg@ + %link!href=@atomLinkHome.arg@ + %updated $cs.formatW3.atomUpdated.arg$ + %id @atomLinkHome.arg@ + $forall atomEntries.arg entry + ^entryTemplate.entry^ |] entryTemplate :: AtomFeedEntry url -> Hamlet url IO () -entryTemplate = [$hamlet| +entryTemplate arg = [$hamlet| %entry - %id @.atomEntryLink@ - %link!href=@.atomEntryLink@ - %updated $.atomEntryUpdated.formatW3.cs$ - %title $.atomEntryTitle.cs$ - %content!type=html $.atomEntryContent.cdata$ + %id @atomEntryLink.arg@ + %link!href=@atomEntryLink.arg@ + %updated $cs.formatW3.atomEntryUpdated.arg$ + %title $cs.atomEntryTitle.arg$ + %content!type=html $cdata.atomEntryContent.arg$ |] diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index e4b9d72b..09eed898 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -92,15 +92,14 @@ getOpenIdR = do (x:_) -> addCookie destCookieTimeout destCookieName x rtom <- getRouteToMaster let message = cs <$> (listToMaybe $ getParams rr "message") - let urlForward = rtom OpenIdForward applyLayout "Log in via OpenID" $ [$hamlet| $maybe message msg %p.message $msg$ -%form!method=get!action=@urlForward@ +%form!method=get!action=@rtom.OpenIdForward@ %label!for=openid OpenID: %input#openid!type=text!name=openid %input!type=submit!value=Login -|] () +|] getOpenIdForward :: GHandler Auth master () getOpenIdForward = do @@ -175,13 +174,13 @@ getCheck = do let arg = (cs $ fromMaybe "" ident, cs $ fromMaybe "" dn) applyLayoutJson "Authentication Status" arg html json where - html = [$hamlet| + html (x, y) = [$hamlet| %h1 Authentication Status %dl %dt identifier - %dd $.fst$ + %dd $x$ %dt displayName - %dd $.snd$ + %dd $y$ |] json (ident, dn) = jsonMap [ ("ident", jsonScalar ident) diff --git a/Yesod/Helpers/EmailAuth.hs b/Yesod/Helpers/EmailAuth.hs index 9fc28c24..0474ff85 100644 --- a/Yesod/Helpers/EmailAuth.hs +++ b/Yesod/Helpers/EmailAuth.hs @@ -71,11 +71,11 @@ getRegisterR = do toMaster <- getRouteToMaster applyLayout "Register a new account" $ [$hamlet| %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 %input#email!type=email!name=email!width=150 %input!type=submit!value=Register -|] () +|] postRegisterR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml postRegisterR = do @@ -93,8 +93,8 @@ postRegisterR = do let verUrl = render $ VerifyR lid verKey liftIO $ sendVerifyEmail y email verKey verUrl 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 = notEmpty -- FIXME @@ -113,7 +113,7 @@ getVerifyR lid key = do redirect RedirectTemporary $ toMaster PasswordR _ -> applyLayout "Invalid verification key" $ [$hamlet| %p I'm sorry, but that was an invalid verification key. - |] () + |] messageKey :: String messageKey = "MESSAGE" @@ -136,8 +136,8 @@ $maybe msg ms %p.message $ms$ %p Please log in to your account. %p - %a!href=@RegisterR.toMaster@ I don't have an account -%form!method=post!action=@LoginR.toMaster@ + %a!href=@toMaster.RegisterR@ I don't have an account +%form!method=post!action=@toMaster.LoginR@ %table %tr %th E-mail @@ -150,7 +150,7 @@ $maybe msg ms %tr %td!colspan=2 %input!type=submit!value=Login -|] () +|] postLoginR :: YesodEmailAuth master => GHandler EmailAuth master () postLoginR = do @@ -181,11 +181,11 @@ getPasswordR = do setMessage "You must be logged in to set a password" redirect RedirectTemporary $ toMaster LoginR msg <- getMessage - applyLayout "Set password" $ [$hamlet| + applyLayout "Set password" [$hamlet| $maybe msg ms %p.message $ms$ %h3 Set a new password -%form!method=post!action=@PasswordR.toMaster@ +%form!method=post!action=@toMaster.PasswordR@ %table %tr %th New password @@ -198,7 +198,7 @@ $maybe msg ms %tr %td!colspan=2 %input!type=submit!value=Submit -|] () +|] postPasswordR :: YesodEmailAuth master => GHandler EmailAuth master () postPasswordR = do diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 3e030fc0..9116dd0c 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -51,14 +51,14 @@ sitemapNS :: HtmlContent sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9" template :: [SitemapUrl url] -> Hamlet url IO () -template = [$hamlet| +template urls = [$hamlet| %urlset!xmlns=$sitemapNS$ - $forall .id url + $forall urls url %url - %loc @url.sitemapLoc@ - %lastmod $url.sitemapLastMod.formatW3.cs$ - %changefreq $url.sitemapChangeFreq.showFreq.cs$ - %priority $url.priority.show.cs$ + %loc @sitemapLoc.url@ + %lastmod $cs.formatW3.sitemapLastMod.url$ + %changefreq $cs.showFreq.sitemapChangeFreq.url$ + %priority $cs.show.priority.url$ |] sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index f4ec0d51..9a62c8b6 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -17,7 +17,6 @@ import Yesod.Request import Yesod.Hamlet import Yesod.Handler import Data.Convertible.Text -import Control.Arrow ((***)) import Network.Wai.Middleware.ClientSession import qualified Network.Wai as W import Yesod.Json @@ -63,15 +62,15 @@ class YesodSite a => Yesod a where -- | Applies some form of layout to the contents of a page. defaultLayout :: PageContent (Routes a) -> GHandler sub a Content - defaultLayout p = hamletToContent $ [$hamlet| + defaultLayout p = hamletToContent [$hamlet| !!! %html %head - %title $p.pageTitle$ - ^p.pageHead^ + %title $pageTitle.p$ + ^pageHead.p^ %body - ^p.pageBody^ -|] () + ^pageBody.p^ +|] -- | Gets called at the beginning of each request. Useful for logging. onRequest :: a -> Request -> IO () @@ -126,30 +125,28 @@ defaultErrorHandler NotFound = do r <- waiRequest applyLayout' "Not Found" $ [$hamlet| %h1 Not Found -%p $.helper$ -|] r +%p $Unencoded.cs.pathInfo.r$ +|] where - helper = Unencoded . cs . W.pathInfo + pathInfo = W.pathInfo defaultErrorHandler PermissionDenied = applyLayout' "Permission Denied" $ [$hamlet| -%h1 Permission denied|] () +%h1 Permission denied|] defaultErrorHandler (InvalidArgs ia) = applyLayout' "Invalid Arguments" $ [$hamlet| %h1 Invalid Arguments %dl - $forall ias pair - %dt $pair.fst$ - %dd $pair.snd$ -|] () - where - ias _ = map (cs *** cs) ia + $forall ia pair + %dt $cs.fst.pair$ + %dd $cs.snd.pair$ +|] defaultErrorHandler (InternalError e) = applyLayout' "Internal Server Error" $ [$hamlet| %h1 Internal Server Error -%p $e.cs$ -|] () +%p $cs.e$ +|] defaultErrorHandler (BadMethod m) = applyLayout' "Bad Method" $ [$hamlet| %h1 Method Not Supported -%p Method "$m.cs$" not supported -|] () +%p Method "$cs.m$" not supported +|]