diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 39d20db0..bb65446b 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -98,7 +98,6 @@ import Yesod.Core.Widget import Yesod.Core.Json import Yesod.Core.Types import Yesod.Core.Internal.Util (formatW3 , formatRFC1123 , formatRFC822) -import Yesod.Core.Widget import Text.Blaze.Html (Html, toHtml, preEscapedToMarkup) import Control.Monad.Logger diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs index 61fc86be..5dc94262 100644 --- a/yesod-core/Yesod/Core/Widget.hs +++ b/yesod-core/Yesod/Core/Widget.hs @@ -66,6 +66,8 @@ module Yesod.Core.Widget , widgetToPageContentUnbound -- Formerly Yesod.Core.Handler + -- * Redirecting + , redirectToPost -- * Streaming , sendChunkHtml -- * Messages @@ -121,6 +123,7 @@ import System.Log.FastLogger (toLogStr) import qualified Data.Text.Lazy as TL import Yesod.Core.Types +import Yesod.Core.Handler (sendResponse, RedirectUrl(..)) import Yesod.Core.Class.Handler import Yesod.Core.Handler (setSession, lookupSession, deleteSession, withUrlRenderer, sendChunk, getUrlRenderParams, getYesod) import Yesod.Core.Content (ToContent(..), ToTypedContent(..), HasContentType(..), ToFlushBuilder(..), typeHtml) @@ -501,6 +504,40 @@ hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html hamletToRepHtml = withUrlRenderer {-# DEPRECATED hamletToRepHtml "Use withUrlRenderer instead" #-} +-- | Redirect to a POST resource. +-- +-- This is not technically a redirect; instead, it returns an HTML page with a +-- POST form, and some Javascript to automatically submit the form. This can be +-- useful when you need to post a plain link somewhere that needs to cause +-- changes on the server. +redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) + => url + -> m a +redirectToPost url = do + urlText <- toTextUrl url + withUrlRenderer (htmlTemplate urlText) >>= sendResponse + where + {- equivalent to + [hamlet| + $newline never + $doctype 5 + + + + Redirecting... + <body onload="document.getElementById('form').submit()"> + <form id="form" method="post" action=#{urlText}> + <noscript> + <p>Javascript has been disabled; please click on the button below to be redirected. + <input type="submit" value="Continue"> + |] + -} + htmlTemplate urlText = \_render_abxV -> do + (H.preEscapedText . Data.Text.pack) "<!DOCTYPE html>\n<html><head><title>Redirecting...
" + + -- | Type-specialized version of 'sendChunk' for @Html@s. -- -- Since 1.2.0 diff --git a/yesod-shakespeare/Yesod/Shakespeare.hs b/yesod-shakespeare/Yesod/Shakespeare.hs index 7862e37d..b836f245 100644 --- a/yesod-shakespeare/Yesod/Shakespeare.hs +++ b/yesod-shakespeare/Yesod/Shakespeare.hs @@ -24,10 +24,6 @@ module Yesod.Shakespeare ( -- * i18n , getMessageRender - -- * Formerly Yesod.Core.Handler - -- ** Redirecting - , redirectToPost - -- * Shakespeare -- ** Hamlet , hamlet @@ -47,12 +43,8 @@ module Yesod.Shakespeare ( , module Text.Shakespeare.I18N ) where -import Control.Monad.IO.Class (MonadIO) -import Control.Monad (liftM, forM) -import Control.Monad.Trans.Class (lift) +import Control.Monad (liftM) import Text.Shakespeare.I18N -import qualified Data.ByteString.Lazy as L -import Data.List (foldl', nub) import Text.Blaze.Html (preEscapedToMarkup, toHtml, Html) import qualified Text.Blaze.Html5 as H import Language.Haskell.TH.Quote (QuasiQuoter) @@ -60,8 +52,7 @@ import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP) import Data.Text (Text) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (fromLazyText, toLazyText) -import Data.Monoid (Last(..), mempty) -import qualified Data.Map as Map +import Data.Monoid (mempty) import qualified Text.Hamlet as NP import Text.Julius (Javascript(..), JavascriptUrl, renderJavascript, renderJavascriptUrl, julius) @@ -70,18 +61,13 @@ import Text.Lucius (Css, renderCss, CssUrl, renderCssUrl, lucius) import Text.Cassius (cassius) import Yesod.Core ( HandlerSite, MonadHandler - , getUrlRenderParams, toTextUrl, invalidArgs, permissionDenied, RedirectUrl, withUrlRenderer, getRequest, getYesod, sendResponse + , getUrlRenderParams, invalidArgs, permissionDenied, getRequest, getYesod , ToContent(..), ToTypedContent(..), HasContentType(..), typeJavascript, typeCss , Route , ToWidget(..), ToWidgetBody(..), ToWidgetMedia(..), ToWidgetHead(..), MonadWidget(..), asWidgetT, tellWidget, GWData(..), setMessage, setTitle ) import Yesod.Core.Types --- for hamlet expansion -import qualified Data.Foldable -import qualified Data.Text -import Text.Hamlet (asHtmlUrl) - type Translate msg = msg -> Html type HtmlUrlI18n msg url = Translate msg -> Render url -> Html type Render url = url -> [(Text, Text)] -> Text @@ -134,32 +120,6 @@ ihamletToHtml ih = do mrender <- getMessageRender return $ ih (toHtml . mrender) urender - --- | Redirect to a POST resource. --- --- This is not technically a redirect; instead, it returns an HTML page with a --- POST form, and some Javascript to automatically submit the form. This can be --- useful when you need to post a plain link somewhere that needs to cause --- changes on the server. -redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) - => url - -> m a -redirectToPost url = do - urlText <- toTextUrl url - withUrlRenderer [hamlet| -$newline never -$doctype 5 - - - - Redirecting... - <body onload="document.getElementById('form').submit()"> - <form id="form" method="post" action=#{urlText}> - <noscript> - <p>Javascript has been disabled; please click on the button below to be redirected. - <input type="submit" value="Continue"> -|] >>= sendResponse - ------------------------------------ -- Formerly Yesod.Core.Content ------------------------------------ diff --git a/yesod-shakespeare/test/YesodShakespeareTest/Media.hs b/yesod-shakespeare/test/YesodShakespeareTest/Media.hs index 3fddb83d..5ea88269 100644 --- a/yesod-shakespeare/test/YesodShakespeareTest/Media.hs +++ b/yesod-shakespeare/test/YesodShakespeareTest/Media.hs @@ -6,7 +6,6 @@ module YesodShakespeareTest.Media (mediaTest, Widget) where import Test.Hspec import Yesod.Core -import Yesod.Core.Widget import Yesod.Shakespeare import Network.Wai import Network.Wai.Test diff --git a/yesod-shakespeare/test/YesodShakespeareTest/Widget.hs b/yesod-shakespeare/test/YesodShakespeareTest/Widget.hs index a6d3ad1f..33876327 100644 --- a/yesod-shakespeare/test/YesodShakespeareTest/Widget.hs +++ b/yesod-shakespeare/test/YesodShakespeareTest/Widget.hs @@ -6,7 +6,6 @@ module YesodShakespeareTest.Widget (widgetTest) where import Test.Hspec import Yesod.Core -import Yesod.Core.Widget import Yesod.Shakespeare import Network.Wai