From 08cc43788c16fb91f63bc0bd520eeccdcdab477a Mon Sep 17 00:00:00 2001 From: dummy Date: Tue, 17 Dec 2013 17:15:33 +0000 Subject: [PATCH] remove and expand TH --- Yesod/Core.hs | 30 +++--- Yesod/Core/Class/Yesod.hs | 249 +++++++++++++++++++++++++++++++-------------- Yesod/Core/Dispatch.hs | 27 ++--- Yesod/Core/Handler.hs | 25 ++--- Yesod/Core/Internal/Run.hs | 4 +- Yesod/Core/Internal/TH.hs | 111 -------------------- Yesod/Core/Widget.hs | 32 +----- 7 files changed, 209 insertions(+), 269 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 12e59d5..2817a69 100644 --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -29,16 +29,16 @@ module Yesod.Core , unauthorizedI -- * Logging , LogLevel (..) - , logDebug - , logInfo - , logWarn - , logError - , logOther - , logDebugS - , logInfoS - , logWarnS - , logErrorS - , logOtherS + --, logDebug + --, logInfo + --, logWarn + --, logError + --, logOther + --, logDebugS + --, logInfoS + --, logWarnS + --, logErrorS + --, logOtherS -- * Sessions , SessionBackend (..) , customizeSessionCookies @@ -85,17 +85,15 @@ module Yesod.Core , readIntegral -- * Shakespeare -- ** Hamlet - , hamlet - , shamlet - , xhamlet + --, hamlet + -- , shamlet + --, xhamlet , HtmlUrl -- ** Julius - , julius + --, julius , JavascriptUrl , renderJavascriptUrl -- ** Cassius/Lucius - , cassius - , lucius , CssUrl , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs index a64d6eb..5dffbfa 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs @@ -5,11 +5,15 @@ {-# LANGUAGE CPP #-} module Yesod.Core.Class.Yesod where -import Control.Monad.Logger (logErrorS) +--import Control.Monad.Logger (logErrorS) import Yesod.Core.Content import Yesod.Core.Handler import Yesod.Routes.Class +import qualified Text.Blaze.Internal +import qualified Control.Monad.Logger +import qualified Text.Hamlet +import qualified Data.Foldable import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) @@ -94,18 +98,27 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage - giveUrlRenderer [hamlet| - $newline never - $doctype 5 - - - #{pageTitle p} - ^{pageHead p} - <body> - $maybe msg <- mmsg - <p .message>#{msg} - ^{pageBody p} - |] + giveUrlRenderer $ \ _render_aHra + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<!DOCTYPE html>\n<html><head><title>"); + id (TBH.toHtml (pageTitle p)); + id ((Text.Blaze.Internal.preEscapedText . T.pack) ""); + Text.Hamlet.asHtmlUrl (pageHead p) _render_aHra; + id ((Text.Blaze.Internal.preEscapedText . T.pack) ""); + Text.Hamlet.maybeH + mmsg + (\ msg_aHrb + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "

"); + id (TBH.toHtml msg_aHrb); + id ((Text.Blaze.Internal.preEscapedText . T.pack) "

") }) + Nothing; + Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra; + id + ((Text.Blaze.Internal.preEscapedText . T.pack) "") } + -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid @@ -370,45 +383,103 @@ widgetToPageContent w = do -- modernizr should be at the end of the http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc - regularScriptLoad = [hamlet| - $newline never - $forall s <- scripts - ^{mkScriptTag s} - $maybe j <- jscript - $maybe s <- jsLoc - ") }) + (Just + (do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) "") }))) + Nothing } + + + headAll = \ _render_aHsW + -> do { Text.Hamlet.asHtmlUrl head' _render_aHsW; + Data.Foldable.mapM_ + (\ s_aHsX -> Text.Hamlet.asHtmlUrl (mkLinkTag s_aHsX) _render_aHsW) + stylesheets; + Data.Foldable.mapM_ + (\ s_aHsY + -> do { Text.Hamlet.maybeH + (right (snd s_aHsY)) + (\ t_aHsZ + -> Text.Hamlet.maybeH + (fst s_aHsY) + (\ media_aHt0 + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "") }) + (Just + (do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "") }))) + Nothing; + Text.Hamlet.maybeH + (left (snd s_aHsY)) + (\ content_aHt1 + -> Text.Hamlet.maybeH + (fst s_aHsY) + (\ media_aHt2 + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "") }) + (Just + (do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "") }))) + Nothing }) + css; + case jsLoader master of { + BottomOfBody -> return () + ; BottomOfHeadAsync asyncJsLoader_aHt3 + -> Text.Hamlet.asHtmlUrl + (asyncJsLoader_aHt3 asyncScripts mcomplete) _render_aHsW + ; BottomOfHeadBlocking + -> Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHsW } } + + let bodyScript = \ _render_aHt8 -> do { Text.Hamlet.asHtmlUrl body _render_aHt8; + Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHt8 } + return $ PageContent title headAll $ case jsLoader master of @@ -438,10 +509,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" - toWidget [hamlet| -

Not Found -

#{path'} - |] + toWidget $ \ _render_aHte + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "

Not Found

\n

"); + id (TBH.toHtml path'); + id ((Text.Blaze.Internal.preEscapedText . T.pack) "

") } + provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. @@ -451,10 +525,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" - toWidget [hamlet| -

Not logged in -

Set the authRoute and the user will be redirected there. - |] + toWidget $ \ _render_aHti + -> id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "

Not logged in

\n

Set the authRoute and the user will be redirected there.

") + provideRep $ do -- 401 *MUST* include a WWW-Authenticate header @@ -476,10 +551,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" - toWidget [hamlet| -

Permission denied -

#{msg} - |] + toWidget $ \ _render_aHtq + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "

Permission denied

\n

"); + id (TBH.toHtml msg); + id ((Text.Blaze.Internal.preEscapedText . T.pack) "

") } + provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) @@ -488,30 +566,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" - toWidget [hamlet| -

Invalid Arguments -