Use macro to chose quasyquote syntax. Reduce clutter caused by
This commit is contained in:
parent
0221258fec
commit
7cd2f9f6c4
@ -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.
|
||||
|
||||
@ -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">
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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}
|
||||
|]
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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://">
|
||||
|
||||
@ -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
10
include/qq.h
Normal 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
|
||||
@ -53,6 +53,8 @@ library
|
||||
Yesod.Auth.HashDB
|
||||
Yesod.Auth.Message
|
||||
ghc-options: -Wall
|
||||
include-dirs:
|
||||
include
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
|
||||
Loading…
Reference in New Issue
Block a user