diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 0fd42b43..dca34270 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -3,6 +3,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} -- | Parse forms (and query strings). module Yesod.Form ( -- * Data types @@ -72,7 +73,12 @@ fieldsToPlain = mapFormXml $ mapM_ fiInput fieldsToTable :: FormField sub y a -> Form sub y a fieldsToTable = mapFormXml $ mapM_ go where - go fi = [$hamlet| + go fi = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %tr.$clazz.fi$ %td %label!for=$fiIdent.fi$ $fiLabel.fi$ @@ -88,7 +94,12 @@ fieldsToTable = mapFormXml $ mapM_ go fieldsToDivs :: FormField sub y a -> Form sub y a fieldsToDivs = mapFormXml $ mapM_ go where - go fi = [$hamlet| + go fi = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif .$clazz.fi$ %label!for=$fiIdent.fi$ $fiLabel.fi$ .tooltip $fiTooltip.fi$ @@ -125,7 +136,14 @@ runFormPost f = do _ -> res return (res', xml, enctype, hidden nonce) where - hidden nonce = [$hamlet|%input!type=hidden!name=$nonceName$!value=$nonce$|] + hidden nonce = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif + %input!type=hidden!name=$nonceName$!value=$nonce$ +|] nonceName :: String nonceName = "_nonce" @@ -158,7 +176,12 @@ runFormTable :: Route m -> String -> FormField s m a -> GHandler s m (FormResult a, GWidget s m ()) runFormTable dest inputLabel form = do (res, widget, enctype, nonce) <- runFormPost $ fieldsToTable form - let widget' = [$hamlet| + let widget' = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %form!method=post!action=@dest@!enctype=$enctype$ %table ^widget^ @@ -174,7 +197,12 @@ runFormDivs :: Route m -> String -> FormField s m a -> GHandler s m (FormResult a, GWidget s m ()) runFormDivs dest inputLabel form = do (res, widget, enctype, nonce) <- runFormPost $ fieldsToDivs form - let widget' = [$hamlet| + let widget' = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %form!method=post!action=@dest@!enctype=$enctype$ ^widget^ %div @@ -199,7 +227,14 @@ generateForm :: GForm s m xml a -> GHandler s m (xml, Enctype, Html) generateForm f = do (_, b, c) <- runFormGeneric [] [] f nonce <- fmap reqNonce getRequest - return (b, c, [$hamlet|%input!type=hidden!name=$nonceName$!value=$nonce$|]) + return (b, c, +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif + %input!type=hidden!name=$nonceName$!value=$nonce$ +|]) -- | Run a form against GET parameters. runFormGet :: GForm s m xml a -> GHandler s m (FormResult a, xml, Enctype) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs index 82e0a9ba..abdfc4b0 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} module Yesod.Form.Fields ( -- * Fields -- ** Required @@ -126,7 +127,12 @@ boolField ffs orig = toForm $ do { fiLabel = string label , fiTooltip = tooltip , fiIdent = theId - , fiInput = [$hamlet| + , fiInput = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!type=checkbox!name=$name$!:val:checked |] , fiErrors = case res of @@ -170,7 +176,12 @@ selectField pairs ffs initial = toForm $ do case res of FormSuccess y -> x == y _ -> Just x == initial - let input = [$hamlet| + let input = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %select#$theId$!name=$name$ %option!value=none $forall pairs' pair @@ -215,7 +226,12 @@ maybeSelectField pairs ffs initial' = toForm $ do case res of FormSuccess y -> Just x == y _ -> Just x == initial - let input = [$hamlet| + let input = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %select#$theId$!name=$name$ %option!value=none $forall pairs' pair @@ -251,7 +267,14 @@ boolInput n = GForm $ do Just "" -> FormSuccess False Just "false" -> FormSuccess False Just _ -> FormSuccess True - let xml = [$hamlet|%input#$n$!type=checkbox!name=$n$|] + let xml = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif + %input#$n$!type=checkbox!name=$n$ +|] return (res, [xml], UrlEncoded) dayInput :: String -> FormInput sub master Day @@ -356,6 +379,11 @@ maybeFileField ffs = toForm $ do return (res, fi, Multipart) fileWidget :: String -> String -> Bool -> GWidget s m () -fileWidget theId name isReq = [$hamlet| +fileWidget theId name isReq = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!type=file!name=$name$!:isReq:required |] diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs index 7158be4a..4e9b4565 100644 --- a/Yesod/Form/Jquery.hs +++ b/Yesod/Form/Jquery.hs @@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} -- | Some fields spiced up with jQuery UI. module Yesod.Form.Jquery ( YesodJquery (..) @@ -75,13 +76,23 @@ jqueryDayFieldProfile jds = FieldProfile . readMay , fpRender = show , fpWidget = \theId name val isReq -> do - addHtml [$hamlet| + addHtml +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJulius [$julius| + addJulius +#if GHC7 + [julius| +#else + [$julius| +#endif $(function(){$("#%theId%").datepicker({ dateFormat:'yy-mm-dd', changeMonth:%jsBool.jdsChangeMonth.jds%, @@ -133,14 +144,24 @@ jqueryDayTimeFieldProfile = FieldProfile { fpParse = parseUTCTime , fpRender = jqueryDayTimeUTCTime , fpWidget = \theId name val isReq -> do - addHtml [$hamlet| + addHtml +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addScript' urlJqueryUiDateTimePicker addStylesheet' urlJqueryUiCss - addJulius [$julius| + addJulius +#if GHC7 + [julius| +#else + [$julius| +#endif $(function(){$("#%theId%").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})}); |] } @@ -177,13 +198,23 @@ jqueryAutocompleteFieldProfile src = FieldProfile { fpParse = Right , fpRender = id , fpWidget = \theId name val isReq -> do - addHtml [$hamlet| + addHtml +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] addScript' urlJqueryJs addScript' urlJqueryUiJs addStylesheet' urlJqueryUiCss - addJulius [$julius| + addJulius +#if GHC7 + [julius| +#else + [$julius| +#endif $(function(){$("#%theId%").autocomplete({source:"@src@",minLength:2})}); |] } diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs index 30622b12..66447a4a 100644 --- a/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs @@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} -- | Provide the user with a rich text editor. module Yesod.Form.Nic ( YesodNic (..) @@ -35,9 +36,23 @@ nicHtmlFieldProfile = FieldProfile { fpParse = Right . preEscapedString . sanitizeBalance , fpRender = lbsToChars . renderHtml , fpWidget = \theId name val _isReq -> do - addHtml [$hamlet|%textarea.html#$theId$!name=$name$ $val$|] + addHtml +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif + %textarea.html#$theId$!name=$name$ $val$ +|] addScript' urlNicEdit - addJulius [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("%theId%")});|] + addJulius +#if GHC7 + [julius| +#else + [$julius| +#endif +bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("%theId%")}); +|] } addScript' :: (y -> Either (Route y) String) -> GWidget sub y () diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs index fb436f92..fa7e16c5 100644 --- a/Yesod/Form/Profiles.hs +++ b/Yesod/Form/Profiles.hs @@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} module Yesod.Form.Profiles ( stringFieldProfile , textareaFieldProfile @@ -35,7 +36,12 @@ intFieldProfile :: Integral i => FieldProfile sub y i intFieldProfile = FieldProfile { fpParse = maybe (Left "Invalid integer") Right . readMayI , fpRender = showI - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$ |] } @@ -49,7 +55,12 @@ doubleFieldProfile :: FieldProfile sub y Double doubleFieldProfile = FieldProfile { fpParse = maybe (Left "Invalid number") Right . readMay , fpRender = show - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] } @@ -58,7 +69,12 @@ dayFieldProfile :: FieldProfile sub y Day dayFieldProfile = FieldProfile { fpParse = parseDate , fpRender = show - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ |] } @@ -67,7 +83,12 @@ timeFieldProfile :: FieldProfile sub y TimeOfDay timeFieldProfile = FieldProfile { fpParse = parseTime , fpRender = show - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!:isReq:required!value=$val$ |] } @@ -76,7 +97,12 @@ htmlFieldProfile :: FieldProfile sub y Html htmlFieldProfile = FieldProfile { fpParse = Right . preEscapedString . sanitizeBalance , fpRender = lbsToChars . renderHtml - , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %textarea.html#$theId$!name=$name$ $val$ |] } @@ -102,7 +128,12 @@ textareaFieldProfile :: FieldProfile sub y Textarea textareaFieldProfile = FieldProfile { fpParse = Right . Textarea , fpRender = unTextarea - , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %textarea#$theId$!name=$name$ $val$ |] } @@ -111,7 +142,12 @@ hiddenFieldProfile :: FieldProfile sub y String hiddenFieldProfile = FieldProfile { fpParse = Right , fpRender = id - , fpWidget = \theId name val _isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val _isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input!type=hidden#$theId$!name=$name$!value=$val$ |] } @@ -120,7 +156,12 @@ stringFieldProfile :: FieldProfile sub y String stringFieldProfile = FieldProfile { fpParse = Right , fpRender = id - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$ |] } @@ -169,7 +210,12 @@ emailFieldProfile = FieldProfile then Right s else Left "Invalid e-mail address" , fpRender = id - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=email!:isReq:required!value=$val$ |] } @@ -180,7 +226,12 @@ urlFieldProfile = FieldProfile Nothing -> Left "Invalid URL" Just _ -> Right s , fpRender = id - , fpWidget = \theId name val isReq -> addHamlet [$hamlet| + , fpWidget = \theId name val isReq -> addHamlet +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %input#$theId$!name=$name$!type=url!:isReq:required!value=$val$ |] } diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 0e6a5160..8a5ea4a8 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/Yesod/Helpers/AtomFeed.hs @@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module : Yesod.Helpers.AtomFeed @@ -49,7 +50,12 @@ data AtomFeedEntry url = AtomFeedEntry } template :: AtomFeed url -> Hamlet url -template arg = [$xhamlet| +template arg = +#if GHC7 + [xhamlet| +#else + [$xhamlet| +#endif %feed!xmlns="http://www.w3.org/2005/Atom" %title $atomTitle.arg$ @@ -62,7 +68,12 @@ template arg = [$xhamlet| |] entryTemplate :: AtomFeedEntry url -> Hamlet url -entryTemplate arg = [$xhamlet| +entryTemplate arg = +#if GHC7 + [xhamlet| +#else + [$xhamlet| +#endif %entry %id @atomEntryLink.arg@ %link!href=@atomEntryLink.arg@ @@ -75,6 +86,11 @@ entryTemplate arg = [$xhamlet| atomLink :: Route m -> String -- ^ title -> GWidget s m () -atomLink u title = addHamletHead [$hamlet| +atomLink u title = addHamletHead +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %link!href=@u@!type="application/atom+xml"!rel="alternate"!title=$title$ |] diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs index 5aebcae9..7690da70 100644 --- a/Yesod/Helpers/Crud.hs +++ b/Yesod/Helpers/Crud.hs @@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Yesod.Helpers.Crud ( Item (..) , Crud (..) @@ -41,7 +42,12 @@ mkYesodSub "Crud master item" , ClassP ''Item [VarT $ mkName "item"] , ClassP ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")] , ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"] - ] [$parseRoutes| + ] +#if GHC7 + [parseRoutes| +#else + [$parseRoutes| +#endif / CrudListR GET /add CrudAddR GET POST /edit/#String CrudEditR GET POST @@ -55,7 +61,12 @@ getCrudListR = do toMaster <- getRouteToMaster defaultLayout $ do setTitle "Items" - addWidget [$hamlet| + addWidget +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Items %ul $forall items item @@ -115,7 +126,12 @@ getCrudDeleteR s = do toMaster <- getRouteToMaster defaultLayout $ do setTitle "Confirm delete" - addWidget [$hamlet| + addWidget +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %form!method=post!action=@toMaster.CrudDeleteR.s@ %h1 Really delete? %p Do you really want to delete $itemTitle.item$? @@ -157,7 +173,12 @@ crudHelper title me isPost = do _ -> return () defaultLayout $ do setTitle $ string title - addWidget [$hamlet| + addWidget +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %p %a!href=@toMaster.CrudListR@ Return to list %h1 $title$ diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 5b009553..34807eb5 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module : Yesod.Helpers.Sitemap @@ -51,7 +52,12 @@ data SitemapUrl url = SitemapUrl } template :: [SitemapUrl url] -> Hamlet url -template urls = [$hamlet| +template urls = +#if GHC7 + [xhamlet| +#else + [$xhamlet| +#endif %urlset!xmlns="http://www.sitemaps.org/schemas/sitemap/0.9" $forall urls url %url @@ -69,4 +75,5 @@ robots :: Route sub -- ^ sitemap url -> GHandler sub master RepPlain robots smurl = do tm <- getRouteToMaster - RepPlain `fmap` hamletToContent [$hamlet|Sitemap: @tm.smurl@|] + render <- getUrlRender + return $ RepPlain $ toContent $ "Sitemap: " ++ render (tm smurl) diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs index 97ddbfe3..20a1cc28 100644 --- a/Yesod/Internal.hs +++ b/Yesod/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} -- | Normal users should never need access to these. module Yesod.Internal ( -- * Error responses @@ -39,6 +40,12 @@ import qualified Data.Text.Encoding.Error as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT +#if GHC7 +#define HAMLET hamlet +#else +#define HAMLET $hamlet +#endif + -- | Responses to indicate some form of an error occurred. These are different -- from 'SpecialResponse' in that they allow for custom error pages. data ErrorResponse = @@ -63,8 +70,8 @@ langKey = "_LANG" data Location url = Local url | Remote String deriving (Show, Eq) locationToHamlet :: Location url -> Hamlet url -locationToHamlet (Local url) = [$hamlet|@url@|] -locationToHamlet (Remote s) = [$hamlet|$s$|] +locationToHamlet (Local url) = [HAMLET|@url@|] +locationToHamlet (Remote s) = [HAMLET|$s$|] newtype UniqueList x = UniqueList ([x] -> [x]) instance Monoid (UniqueList x) where diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index dce31ef6..0fbd2881 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -73,6 +73,12 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit hiding (Test) #endif +#if GHC7 +#define HAMLET hamlet +#else +#define HAMLET $hamlet +#endif + -- | This class is automatically instantiated when you use the template haskell -- mkYesod function. You should never need to deal with it directly. class Eq (Route y) => YesodSite y where @@ -117,7 +123,7 @@ class Eq (Route a) => Yesod a where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage - hamletToRepHtml [$hamlet| + hamletToRepHtml [HAMLET| !!! %html %head @@ -312,31 +318,56 @@ defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep defaultErrorHandler NotFound = do r <- waiRequest let path' = bsToChars $ pathInfo r - applyLayout' "Not Found" $ [$hamlet| + applyLayout' "Not Found" [hamlet| +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Not Found %p $path'$ |] where pathInfo = W.pathInfo defaultErrorHandler (PermissionDenied msg) = - applyLayout' "Permission Denied" $ [$hamlet| + applyLayout' "Permission Denied" +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Permission denied %p $msg$ |] defaultErrorHandler (InvalidArgs ia) = - applyLayout' "Invalid Arguments" $ [$hamlet| + applyLayout' "Invalid Arguments" +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Invalid Arguments %ul $forall ia msg %li $msg$ |] defaultErrorHandler (InternalError e) = - applyLayout' "Internal Server Error" $ [$hamlet| + applyLayout' "Internal Server Error" +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Internal Server Error %p $e$ |] defaultErrorHandler (BadMethod m) = - applyLayout' "Bad Method" $ [$hamlet| + applyLayout' "Bad Method" +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif %h1 Method Not Supported %p Method "$m$" not supported |] @@ -416,7 +447,12 @@ widgetToPageContent (GWidget w) = do $ renderJulius render s return $ renderLoc x - let head'' = [$hamlet| + let head'' = +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif $forall scripts s %script!src=^s^ $forall stylesheets s @@ -490,7 +526,12 @@ caseUtf8JoinPath = do -- useful when you need to post a plain link somewhere that needs to cause -- changes on the server. redirectToPost :: Route master -> GHandler sub master a -redirectToPost dest = hamletToRepHtml [$hamlet| +redirectToPost dest = hamletToRepHtml +#if GHC7 + [hamlet| +#else + [$hamlet| +#endif !!! %html %head diff --git a/scaffold.hs b/scaffold.hs index 36f6deed..cfca5303 100644 --- a/scaffold.hs +++ b/scaffold.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} import CodeGen import System.IO import System.Directory @@ -10,6 +11,13 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT +qq :: String +#if GHC7 +qq = "" +#else +qq = "$" +#endif + main :: IO () main = do putStr $(codegen "welcome") diff --git a/scaffold/Model_hs.cg b/scaffold/Model_hs.cg index 7ad3062d..4fa4dec6 100644 --- a/scaffold/Model_hs.cg +++ b/scaffold/Model_hs.cg @@ -8,7 +8,7 @@ import Database.Persist.GenericSql (mkMigrate) -- You can define all of your database entities here. You can find more -- information on persistent and how to declare entities at: -- http://docs.yesodweb.com/book/persistent/ -share2 mkPersist (mkMigrate "migrateAll") [$persist| +share2 mkPersist (mkMigrate "migrateAll") [~qq~persist| User ident String password String null update diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg_hs.cg index 2c693f05..dad00631 100644 --- a/scaffold/sitearg_hs.cg +++ b/scaffold/sitearg_hs.cg @@ -68,7 +68,7 @@ type Widget = GWidget ~sitearg~ ~sitearg~ -- for our application to be in scope. However, the handler functions -- usually require access to the ~sitearg~Route datatype. Therefore, we -- split these actions into two functions and place them in separate files. -mkYesodData "~sitearg~" [$parseRoutes| +mkYesodData "~sitearg~" [~qq~parseRoutes| /static StaticR Static getStatic /auth AuthR Auth getAuth @@ -175,7 +175,7 @@ instance YesodAuthEmail ~sitearg~ where { partType = "text/html; charset=utf-8" , partEncoding = None , partFilename = Nothing - , partContent = renderHtml [$hamlet| + , partContent = renderHtml [~qq~hamlet| %p Please confirm your email address by clicking on the link below. %p %a!href=$verurl$ $verurl$ diff --git a/yesod.cabal b/yesod.cabal index 0b8deb1d..1312cd4b 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -20,9 +20,15 @@ flag test description: Build the executable to run unit tests default: False +flag ghc7 + library - build-depends: base >= 4 && < 5 - , time >= 1.1.4 && < 1.3 + if flag(ghc7) + build-depends: base >= 4.3 && < 5 + cpp-options: -DGHC7 + else + build-depends: base >= 4 && < 4.3 + build-depends: time >= 1.1.4 && < 1.3 , wai >= 0.2.0 && < 0.3 , wai-extra >= 0.2.4 && < 0.3 , bytestring >= 0.9.1.4 && < 0.10 @@ -72,6 +78,11 @@ library ghc-options: -Wall executable yesod + if flag(ghc7) + build-depends: base >= 4.3 && < 5 + cpp-options: -DGHC7 + else + build-depends: base >= 4 && < 4.3 build-depends: parsec >= 2.1 && < 4 ghc-options: -Wall main-is: scaffold.hs @@ -79,6 +90,11 @@ executable yesod extensions: TemplateHaskell executable runtests + if flag(ghc7) + build-depends: base >= 4.3 && < 5 + cpp-options: -DGHC7 + else + build-depends: base >= 4 && < 4.3 if flag(test) Buildable: True cpp-options: -DTEST