Finished deprecating old Widget functions
This commit is contained in:
parent
4cc468ca3b
commit
e62e4b8721
@ -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>
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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;
|
||||
|]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|]
|
||||
|
||||
@ -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}
|
||||
|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user