Use macro to chose quasyquote syntax. Reduce clutter caused by

This commit is contained in:
Alexey Khudyakov 2011-06-05 01:24:54 +04:00
parent 0221258fec
commit 7cd2f9f6c4
10 changed files with 47 additions and 103 deletions

View File

@ -22,6 +22,8 @@ module Yesod.Auth
, requireAuth
) where
#include "qq.h"
import Yesod.Core
import Yesod.Persist
import Yesod.Json
@ -91,11 +93,7 @@ mkYesodSub "Auth"
[ ClassP ''YesodAuth [VarT $ mkName "master"]
]
#define STRINGS *Texts
#if GHC7
[parseRoutes|
#else
[$parseRoutes|
#endif
[QQ(parseRoutes)|
/check CheckR GET
/login LoginR GET
/logout LogoutR GET POST
@ -117,13 +115,7 @@ setCreds doRedirects creds = do
case authRoute y of
Nothing -> do
rh <- defaultLayout
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
<h1>Invalid login
|]
[QQ(hamlet)| <h1>Invalid login |]
sendResponse rh
Just ar -> do
setMessageI Msg.InvalidLogin
@ -145,11 +137,7 @@ getCheckR = do
addHtml $ html creds) (json' creds)
where
html creds =
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
[QQ(hamlet)|
<h1>Authentication Status
$maybe _ <- creds
<p>Logged in.

View File

@ -8,6 +8,8 @@ module Yesod.Auth.Dummy
( authDummy
) where
#include "qq.h"
import Yesod.Auth
import Yesod.Form (runInputPost, textField, ireq)
import Yesod.Handler (notFound)
@ -23,11 +25,7 @@ authDummy =
dispatch _ _ = notFound
url = PluginR "dummy" []
login authToMaster =
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
[QQ(hamlet)|
<form method="post" action="@{authToMaster url}">
\Your new identifier is:
<input type="text" name="ident">

View File

@ -14,6 +14,8 @@ module Yesod.Auth.Email
, setpassR
) where
#include "qq.h"
import Network.Mail.Mime (randomString)
import Yesod.Auth
import System.Random
@ -81,11 +83,7 @@ authEmail =
AuthPlugin "email" dispatch $ \tm -> do
y <- lift getYesod
l <- lift languages
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
[QQ(whamlet)|
<form method="post" action="@{tm loginR}">
<table>
<tr>
@ -119,11 +117,7 @@ getRegisterR = do
defaultLayout $ do
setTitleI Msg.RegisterLong
addWidget
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
[QQ(whamlet)|
<p>_{Msg.EnterEmail}
<form method="post" action="@{toMaster registerR}">
<label for="email">_{Msg.Email}
@ -154,13 +148,7 @@ postRegisterR = do
defaultLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle
addWidget
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
<p>_{Msg.ConfirmationEmailSent email}
|]
[QQ(whamlet)| <p>_{Msg.ConfirmationEmailSent email} |]
getVerifyR :: YesodAuthEmail m
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml
@ -181,13 +169,7 @@ getVerifyR lid key = do
defaultLayout $ do
setTitleI Msg.InvalidKey
addWidget
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
<p>_{Msg.InvalidKey}
|]
[QQ(whamlet)| <p>_{Msg.InvalidKey} |]
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
postLoginR = do
@ -226,11 +208,7 @@ getPasswordR = do
defaultLayout $ do
setTitleI Msg.SetPassTitle
addWidget
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
[QQ(whamlet)|
<h3>_{Msg.SetPass}
<form method="post" action="@{toMaster setpassR}">
<table>

View File

@ -6,6 +6,8 @@ module Yesod.Auth.Facebook
, facebookUrl
) where
#include "qq.h"
import Yesod.Auth
import qualified Web.Authenticate.Facebook as Facebook
import Data.Aeson
@ -56,11 +58,7 @@ authFacebook cid secret perms =
render <- lift getUrlRender
let fb = Facebook.Facebook cid secret $ render $ tm url
let furl = Facebook.getForwardUrl fb $ perms
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
[QQ(whamlet)|
<p>
<a href="#{furl}">_{Msg.Facebook}
|]

View File

@ -64,6 +64,8 @@ module Yesod.Auth.HashDB
, migrateUsers
) where
#include "qq.h"
import Yesod.Persist
import Yesod.Handler
import Yesod.Form
@ -82,11 +84,7 @@ sha1String = showDigest . sha1 . pack
-- | Generate data base instances for a valid user
share2 mkPersist (mkMigrate "migrateUsers")
#if GHC7
[persist|
#else
[$persist|
#endif
[QQ(persist)|
User
username Text Eq
password Text
@ -128,13 +126,7 @@ postLoginR = do
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
else do
setMessage
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
Invalid username/password
|]
[QQ(hamlet)| Invalid username/password |]
toMaster <- getRouteToMaster
redirect RedirectTemporary $ toMaster LoginR
@ -158,14 +150,7 @@ getAuthIdHashDB authR creds = do
-- user exists
Just (uid, _) -> return $ Just uid
Nothing -> do
setMessage
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
User not found
|]
setMessage [QQ(hamlet)| User not found |]
redirect RedirectTemporary $ authR LoginR
-- | Prompt for username and password, validate that against a database
@ -175,11 +160,7 @@ authHashDB :: (YesodAuth y,
PersistBackend (YesodDB y (GGHandler Auth y IO)))
=> AuthPlugin y
authHashDB = AuthPlugin "hashdb" dispatch $ \tm ->
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
[QQ(hamlet)|
<div id="header">
<h1>Login

View File

@ -6,6 +6,9 @@ module Yesod.Auth.OAuth
, authTwitter
, twitterUrl
) where
#include "qq.h"
import Yesod.Auth
import Yesod.Form
import Yesod.Handler
@ -66,13 +69,7 @@ authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch lo
render <- lift getUrlRender
let oaUrl = render $ tm $ oauthUrl name
addHtml
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
<a href=#{oaUrl}>Login with #{name}
|]
[QQ(hamlet)| <a href=#{oaUrl}>Login with #{name} |]
authTwitter :: YesodAuth m =>
String -- ^ Consumer Key

View File

@ -6,6 +6,8 @@ module Yesod.Auth.OpenId
, forwardUrl
) where
#include "qq.h"
import Yesod.Auth
import qualified Web.Authenticate.OpenId as OpenId
import Control.Monad.Attempt
@ -34,20 +36,12 @@ authOpenId =
ident <- lift newIdent
y <- lift getYesod
addCassius
#if GHC7
[cassius|##{ident}
#else
[$cassius|##{ident}
#endif
[QQ(cassius)|##{ident}
background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
padding-left: 18px;
|]
l <- lift languages
#if GHC7
[whamlet|
#else
[$whamlet|
#endif
[QQ(whamlet)|
<form method="get" action="@{tm forwardUrl}">
<label for="#{ident}">OpenID: #
<input id="#{ident}" type="text" name="#{name}" value="http://">

View File

@ -5,6 +5,8 @@ module Yesod.Auth.Rpxnow
( authRpxnow
) where
#include "qq.h"
import Yesod.Auth
import qualified Web.Authenticate.Rpxnow as Rpxnow
import Control.Monad (mplus)
@ -27,11 +29,7 @@ authRpxnow app apiKey =
login tm = do
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
addHamlet
#if GHC7
[hamlet|
#else
[$hamlet|
#endif
[QQ(hamlet)|
<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
|]
dispatch _ [] = do

10
include/qq.h Normal file
View File

@ -0,0 +1,10 @@
-- CPP macro which choses which quasyquotes syntax to use depending
-- on GHC version.
--
-- QQ stands for quasyquote.
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif

View File

@ -53,6 +53,8 @@ library
Yesod.Auth.HashDB
Yesod.Auth.Message
ghc-options: -Wall
include-dirs:
include
source-repository head
type: git