Finished deprecating old Widget functions

This commit is contained in:
Michael Snoyman 2012-03-13 13:11:05 +02:00
parent 4cc468ca3b
commit e62e4b8721
10 changed files with 37 additions and 45 deletions

View File

@ -31,8 +31,7 @@ import qualified Data.Text.Encoding as DTE
import Yesod.Form
import Yesod.Handler
import Yesod.Content
import Yesod.Widget
import Yesod.Core
import Yesod.Core (PathPiece, fromPathPiece, whamlet, defaultLayout, setTitleI, toPathPiece)
import Control.Monad.IO.Class (liftIO)
import qualified Yesod.Auth.Message as Msg
@ -113,8 +112,7 @@ getRegisterR = do
toMaster <- getRouteToMaster
defaultLayout $ do
setTitleI Msg.RegisterLong
addWidget
[whamlet|
[whamlet|
<p>_{Msg.EnterEmail}
<form method="post" action="@{toMaster registerR}">
<label for="email">_{Msg.Email}
@ -144,8 +142,7 @@ postRegisterR = do
sendVerifyEmail email verKey verUrl
defaultLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle
addWidget
[whamlet| <p>_{Msg.ConfirmationEmailSent email} |]
[whamlet| <p>_{Msg.ConfirmationEmailSent email} |]
getVerifyR :: YesodAuthEmail m
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml
@ -165,8 +162,7 @@ getVerifyR lid key = do
_ -> return ()
defaultLayout $ do
setTitleI Msg.InvalidKey
addWidget
[whamlet| <p>_{Msg.InvalidKey} |]
[whamlet| <p>_{Msg.InvalidKey} |]
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
postLoginR = do
@ -204,8 +200,7 @@ getPasswordR = do
redirect $ toMaster LoginR
defaultLayout $ do
setTitleI Msg.SetPassTitle
addWidget
[whamlet|
[whamlet|
<h3>_{Msg.SetPass}
<form method="post" action="@{toMaster setpassR}">
<table>

View File

@ -19,7 +19,7 @@ import Yesod.Auth
import qualified Web.Authenticate.OpenId as OpenId
import Yesod.Handler
import Yesod.Widget
import Yesod.Widget (whamlet)
import Yesod.Request
import Text.Blaze (toHtml)
import Data.Text (Text)

View File

@ -76,7 +76,7 @@ import Yesod.Persist
import Yesod.Handler
import Yesod.Form
import Yesod.Auth
import Yesod.Widget (addHamlet)
import Yesod.Widget (toWidget)
import Text.Hamlet (hamlet, shamlet)
import Control.Applicative ((<$>), (<*>))
@ -221,8 +221,7 @@ authHashDB :: ( YesodAuth m, YesodPersist m
, PersistStore b (GHandler Auth m)
, PersistUnique b (GHandler Auth m))
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
[hamlet|
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
<div id="header">
<h1>Login

View File

@ -12,7 +12,7 @@ import qualified Web.Authenticate.OpenId as OpenId
import Yesod.Form
import Yesod.Handler
import Yesod.Widget
import Yesod.Widget (toWidget, whamlet)
import Yesod.Request
import Text.Cassius (cassius)
import Text.Blaze (toHtml)
@ -34,8 +34,7 @@ authOpenIdExtended extensionFields =
name = "openid_identifier"
login tm = do
ident <- lift newIdent
addCassius
[cassius|##{ident}
toWidget [cassius|##{ident}
background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
padding-left: 18px;
|]

View File

@ -25,8 +25,7 @@ authRpxnow app apiKey =
where
login tm = do
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
addHamlet
[hamlet|
toWidget [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

View File

@ -485,7 +485,7 @@ applyLayout' :: Yesod master
-> GHandler sub master ChooseRep
applyLayout' title body = fmap chooseRep $ defaultLayout $ do
setTitle title
addHamlet body
toWidget body
-- | The default error handler for 'errorHandler'.
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep

View File

@ -114,37 +114,37 @@ class ToWidget sub master a where
type RY master = Route master -> [(Text, Text)] -> Text
instance render ~ RY master => ToWidget sub master (render -> Html) where
toWidget = addHamlet
toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
instance render ~ RY master => ToWidget sub master (render -> Css) where
toWidget = addCassius
toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ \r -> fromLazyText $ renderCss $ x r) mempty mempty
instance render ~ RY master => ToWidget sub master (render -> Javascript) where
toWidget = addJulius
toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
instance ToWidget sub master (GWidget sub master ()) where
toWidget = id
instance ToWidget sub master Html where
toWidget = addHtml
toWidget = toWidget . const
class ToWidgetBody sub master a where
toWidgetBody :: a -> GWidget sub master ()
instance render ~ RY master => ToWidgetBody sub master (render -> Html) where
toWidgetBody = addHamlet
toWidgetBody = toWidget
instance render ~ RY master => ToWidgetBody sub master (render -> Javascript) where
toWidgetBody = addJuliusBody
toWidgetBody j = toWidget $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
instance ToWidgetBody sub master Html where
toWidgetBody = addHtml
toWidgetBody = toWidget
class ToWidgetHead sub master a where
toWidgetHead :: a -> GWidget sub master ()
instance render ~ RY master => ToWidgetHead sub master (render -> Html) where
toWidgetHead = addHamletHead
toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
instance render ~ RY master => ToWidgetHead sub master (render -> Css) where
toWidgetHead = addCassius
toWidgetHead = toWidget
instance render ~ RY master => ToWidgetHead sub master (render -> Javascript) where
toWidgetHead = addJulius
toWidgetHead = toWidget
instance ToWidgetHead sub master Html where
toWidgetHead = addHtmlHead
toWidgetHead = toWidgetHead . const
-- | Set the page title. Calling 'setTitle' multiple times overrides previously
-- set values.
@ -164,19 +164,19 @@ setTitleI msg = do
-- | Add a 'Hamlet' to the head tag.
addHamletHead :: HtmlUrl (Route master) -> GWidget sub master ()
addHamletHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
addHamletHead = toWidgetHead
-- | Add a 'Html' to the head tag.
addHtmlHead :: Html -> GWidget sub master ()
addHtmlHead = addHamletHead . const
addHtmlHead = toWidgetHead . const
-- | Add a 'Hamlet' to the body tag.
addHamlet :: HtmlUrl (Route master) -> GWidget sub master ()
addHamlet x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
addHamlet = toWidget
-- | Add a 'Html' to the body tag.
addHtml :: Html -> GWidget sub master ()
addHtml = addHamlet . const
addHtml = toWidget
-- | Add another widget. This is defined as 'id', by can help with types, and
-- makes widget blocks look more consistent.
@ -185,11 +185,11 @@ addWidget = id
-- | Add some raw CSS to the style tag. Applies to all media types.
addCassius :: CssUrl (Route master) -> GWidget sub master ()
addCassius x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ \r -> fromLazyText $ renderCss $ x r) mempty mempty
addCassius = toWidget
-- | Identical to 'addCassius'.
addLucius :: CssUrl (Route master) -> GWidget sub master ()
addLucius = addCassius
addLucius = toWidget
-- | Add some raw CSS to the style tag, for a specific media type.
addCassiusMedia :: Text -> CssUrl (Route master) -> GWidget sub master ()
@ -239,12 +239,12 @@ addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remot
-- | Include raw Javascript in the page's script tag.
addJulius :: JavascriptUrl (Route master) -> GWidget sub master ()
addJulius x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
addJulius = toWidget
-- | Add a new script tag to the body with the contents of this 'Julius'
-- template.
addJuliusBody :: JavascriptUrl (Route master) -> GWidget sub master ()
addJuliusBody j = addHamlet $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
addJuliusBody = toWidgetBody
-- | Content for a web page. By providing this datatype, we can easily create
-- generic site templates, which would have the type signature:
@ -264,7 +264,7 @@ whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
rules :: Q NP.HamletRules
rules = do
ah <- [|addHtml|]
ah <- [|toWidget|]
let helper qg f = do
x <- newName "urender"
e <- f $ VarE x

View File

@ -63,7 +63,7 @@ widgetFileNoReload x = do
let c = whenExists x "cassius" cassiusFile
let j = whenExists x "julius" juliusFile
let l = whenExists x "lucius" luciusFile
[|$h >> addCassius $c >> addJulius $j >> addLucius $l|]
[|$h >> toWidget $c >> toWidget $j >> toWidget $l|]
widgetFileReload :: FilePath -> Q Exp
widgetFileReload x = do
@ -71,7 +71,7 @@ widgetFileReload x = do
let c = whenExists x "cassius" cassiusFileReload
let j = whenExists x "julius" juliusFileReload
let l = whenExists x "lucius" luciusFileReload
[|$h >> addCassius $c >> addJulius $j >> addLucius $l|]
[|$h >> toWidget $c >> toWidget $j >> toWidget $l|]
widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload)
-> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("julius", juliusFileReload)
@ -80,7 +80,7 @@ widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = do
let h = whenExists x "hamlet" whamletFile
let c = whenExists x csExt csLoad
let j = whenExists x jsExt jsLoad
[|$h >> addCassius $c >> addJulius $j|]
[|$h >> toWidget $c >> toWidget $j|]
whenExists :: String -> String -> (FilePath -> Q Exp) -> Q Exp
whenExists = warnUnlessExists False

View File

@ -66,6 +66,6 @@ entryTemplate arg = [xhamlet|
atomLink :: Route m
-> Text -- ^ title
-> GWidget s m ()
atomLink r title = addHamletHead [hamlet|
atomLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}
|]

View File

@ -63,6 +63,6 @@ entryTemplate arg = [xhamlet|
rssLink :: Route m
-> Text -- ^ title
-> GWidget s m ()
rssLink r title = addHamletHead [hamlet|
rssLink r title = toWidgetHead [hamlet|
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}
|]