Use macro to chose quasyquote syntax. Reduce clutter caused by

Yesod/Auth.hs

@@ -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
+    [QQ(parseRoutes)|
-    [parseRoutes|
-#else
-    [$parseRoutes|
-#endif
 /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
+                                [QQ(hamlet)| <h1>Invalid login |]
-                                [hamlet|
-#else
-                                [$hamlet|
-#endif
-                                <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
+        [QQ(hamlet)|
-        [hamlet|
-#else
-        [$hamlet|
-#endif
 <h1>Authentication Status
 $maybe _ <- creds
     <p>Logged in.

Yesod/Auth/Dummy.hs

@@ -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
+        [QQ(hamlet)|
-        [hamlet|
-#else
-        [$hamlet|
-#endif
 <form method="post" action="@{authToMaster url}">
     \Your new identifier is: 
     <input type="text" name="ident">

Yesod/Auth/Email.hs

@@ -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
+        [QQ(whamlet)|
-        [whamlet|
-#else
-        [$whamlet|
-#endif
 <form method="post" action="@{tm loginR}">
     <table>
         <tr>
@@ -119,11 +117,7 @@ getRegisterR = do
     defaultLayout $ do
         setTitleI Msg.RegisterLong
         addWidget
-#if GHC7
+            [QQ(whamlet)|
-            [whamlet|
-#else
-            [$whamlet|
-#endif
 <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
+            [QQ(whamlet)| <p>_{Msg.ConfirmationEmailSent email} |]
-            [whamlet|
-#else
-            [$whamlet|
-#endif
-<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
+            [QQ(whamlet)| <p>_{Msg.InvalidKey} |]
-            [whamlet|
-#else
-            [$whamlet|
-#endif
-<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
+            [QQ(whamlet)|
-            [whamlet|
-#else
-            [$whamlet|
-#endif
 <h3>_{Msg.SetPass}
 <form method="post" action="@{toMaster setpassR}">
     <table>

Yesod/Auth/Facebook.hs

@@ -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
+        [QQ(whamlet)|
-        [whamlet|
-#else
-        [$whamlet|
-#endif
 <p>
     <a href="#{furl}">_{Msg.Facebook}
 |]

Yesod/Auth/HashDB.hs

@@ -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
+         [QQ(persist)|
-            [persist|
-#else
-            [$persist|
-#endif
 User
     username Text Eq
     password Text
@@ -128,13 +126,7 @@ postLoginR = do
         then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
         else do
             setMessage
-#if GHC7
+                [QQ(hamlet)| Invalid username/password |]
-                [hamlet|
-#else
-                [$hamlet|
-#endif
-    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
+                    setMessage [QQ(hamlet)| User not found |]
-#if GHC7
-                        [hamlet|
-#else
-                        [$hamlet|
-#endif
-    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
+    [QQ(hamlet)|
-    [hamlet|
-#else
-    [$hamlet|
-#endif
     <div id="header">
         <h1>Login
 

Yesod/Auth/OAuth.hs

@@ -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
+          [QQ(hamlet)| <a href=#{oaUrl}>Login with #{name} |]
-          [hamlet|
-#else
-          [$hamlet|
-#endif
-             <a href=#{oaUrl}>Login with #{name}
-          |]
 
 authTwitter :: YesodAuth m =>
                String -- ^ Consumer Key

Yesod/Auth/OpenId.hs

@@ -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
+            [QQ(cassius)|##{ident}
-            [cassius|##{ident}
-#else
-            [$cassius|##{ident}
-#endif
     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
+        [QQ(whamlet)|
-        [whamlet|
-#else
-        [$whamlet|
-#endif
 <form method="get" action="@{tm forwardUrl}">
     <label for="#{ident}">OpenID: #
     <input id="#{ident}" type="text" name="#{name}" value="http://">

Yesod/Auth/Rpxnow.hs

@@ -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
+            [QQ(hamlet)|
-            [hamlet|
-#else
-            [$hamlet|
-#endif
 <iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
 |]
     dispatch _ [] = do

include/qq.h

@@ -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

yesod-auth.cabal

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