haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move away from RepHtml some more

Browse Source
This commit is contained in:
Michael Snoyman 2013-05-20 09:16:53 +03:00
parent 44c5b03a6e
commit 743966898d
11 changed files with 33 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-core/Yesod/Core/Class/Yesod.hs
View File

@ -83,11 +83,11 @@ class RenderRoute site => Yesod site where
errorHandler = defaultErrorHandler errorHandler = defaultErrorHandler
-- | Applies some form of layout to the contents of a page. -- | Applies some form of layout to the contents of a page.
defaultLayout :: WidgetT site IO () -> HandlerT site IO RepHtml defaultLayout :: WidgetT site IO () -> HandlerT site IO Html
defaultLayout w = do defaultLayout w = do
p <- widgetToPageContent w p <- widgetToPageContent w
mmsg <- getMessage mmsg <- getMessage
hamletToRepHtml [hamlet| giveUrlRenderer [hamlet|
$newline never $newline never
$doctype 5 $doctype 5
<html> <html>

1
yesod-core/Yesod/Core/Types.hs
View File

@ -266,6 +266,7 @@ data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content an
data TypedContent = TypedContent !ContentType !Content data TypedContent = TypedContent !ContentType !Content
type RepHtml = Html type RepHtml = Html
{-# DEPRECATED RepHtml "Please use Html instead" #-}
newtype RepJson = RepJson Content newtype RepJson = RepJson Content
newtype RepPlain = RepPlain Content newtype RepPlain = RepPlain Content
newtype RepXml = RepXml Content newtype RepXml = RepXml Content

12
yesod-core/Yesod/Core/Widget.hs
View File

@ -19,6 +19,7 @@ module Yesod.Core.Widget
, whamlet , whamlet
, whamletFile , whamletFile
, ihamletToRepHtml , ihamletToRepHtml
, ihamletToHtml
-- * Convert to Widget -- * Convert to Widget
, ToWidget (..) , ToWidget (..)
, ToWidgetHead (..) , ToWidgetHead (..)
@ -220,7 +221,16 @@ rules = do
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m)) => HtmlUrlI18n message (Route (HandlerSite m))
-> m Html -> m Html
ihamletToRepHtml ih = do ihamletToRepHtml = ihamletToHtml
{-# DEPRECATED ihamletToRepHtml "Please use ihamletToHtml instead" #-}
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
--
-- Since 1.2.1
ihamletToHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
=> HtmlUrlI18n message (Route (HandlerSite m))
-> m Html
ihamletToHtml ih = do
urender <- getUrlRenderParams urender <- getUrlRenderParams
mrender <- getMessageRender mrender <- getMessageRender
return $ ih (toHtml . mrender) urender return $ ih (toHtml . mrender) urender

2
yesod-core/test/YesodCoreTest/Auth.hs
View File

@ -35,7 +35,7 @@ handleForbiddenR = return ()
handleNeedsLoginJsonR :: Handler RepJson handleNeedsLoginJsonR :: Handler RepJson
handleNeedsLoginJsonR = return $ repJson $ object [] handleNeedsLoginJsonR = return $ repJson $ object []
handleNeedsLoginHtmlR :: Handler RepHtml handleNeedsLoginHtmlR :: Handler Html
handleNeedsLoginHtmlR = return "" handleNeedsLoginHtmlR = return ""
test :: String -- ^ method test :: String -- ^ method

8
yesod-core/test/YesodCoreTest/ErrorHandling.hs
View File

@ -26,7 +26,7 @@ mkYesod "App" [parseRoutes|
instance Yesod App instance Yesod App
getHomeR :: Handler RepHtml getHomeR :: Handler Html
getHomeR = do getHomeR = do
$logDebug "Testing logging" $logDebug "Testing logging"
defaultLayout $ toWidget [hamlet| defaultLayout $ toWidget [hamlet|
@ -42,7 +42,7 @@ $doctype 5
<input type=submit value="BUGGY: Error thrown after runRequestBody"> <input type=submit value="BUGGY: Error thrown after runRequestBody">
|] |]
postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler Html
postNotFoundR = do postNotFoundR = do
(_, _files) <- runRequestBody (_, _files) <- runRequestBody
_ <- notFound _ <- notFound
@ -57,12 +57,12 @@ postAfterRunRequestBodyR = do
_ <- error $ show $ fst x _ <- error $ show $ fst x
getHomeR getHomeR
getErrorInBodyR :: Handler RepHtml getErrorInBodyR :: Handler Html
getErrorInBodyR = do getErrorInBodyR = do
let foo = error "error in body 19328" :: String let foo = error "error in body 19328" :: String
defaultLayout [whamlet|#{foo}|] defaultLayout [whamlet|#{foo}|]
getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate RepHtml) getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate Html)
getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR
errorHandlingTest :: Spec errorHandlingTest :: Spec

2
yesod-core/test/YesodCoreTest/JsLoader.hs
View File

@ -17,7 +17,7 @@ mkYesod "H" [parseRoutes|
instance Yesod H where instance Yesod H where
jsLoader _ = BottomOfHeadBlocking jsLoader _ = BottomOfHeadBlocking
getHeadR :: Handler RepHtml getHeadR :: Handler Html
getHeadR = defaultLayout $ addScriptRemote "load.js" getHeadR = defaultLayout $ addScriptRemote "load.js"
specs :: Spec specs :: Spec

3
yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs
View File

@ -12,6 +12,5 @@ mkYesod "B" [parseRoutes|
instance Yesod B where instance Yesod B where
jsLoader _ = BottomOfBody jsLoader _ = BottomOfBody
getBottomR :: Handler RepHtml getBottomR :: Handler Html
getBottomR = defaultLayout $ addScriptRemote "load.js" getBottomR = defaultLayout $ addScriptRemote "load.js"

6
yesod-core/test/YesodCoreTest/Links.hs
View File

@ -36,13 +36,13 @@ instance PathPiece (Foo x y)
instance Yesod Y instance Yesod Y
getRootR :: Handler RepHtml getRootR :: Handler Html
getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|] getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|]
getTextR :: Text -> Handler RepHtml getTextR :: Text -> Handler Html
getTextR foo = defaultLayout $ toWidget [hamlet|%#{foo}%|] getTextR foo = defaultLayout $ toWidget [hamlet|%#{foo}%|]
getTextsR :: [Text] -> Handler RepHtml getTextsR :: [Text] -> Handler Html
getTextsR foos = defaultLayout $ toWidget [hamlet|%#{show foos}%|] getTextsR foos = defaultLayout $ toWidget [hamlet|%#{show foos}%|]
getRT1 :: [Text] -> Handler () getRT1 :: [Text] -> Handler ()

4
yesod-core/test/YesodCoreTest/Media.hs
View File

@ -23,13 +23,13 @@ instance Yesod Y where
else "all.css" else "all.css"
_ -> return Nothing _ -> return Nothing
getRootR :: Handler RepHtml getRootR :: Handler Html
getRootR = defaultLayout $ do getRootR = defaultLayout $ do
toWidget [lucius|foo1{bar:baz}|] toWidget [lucius|foo1{bar:baz}|]
toWidgetMedia "screen" [lucius|foo2{bar:baz}|] toWidgetMedia "screen" [lucius|foo2{bar:baz}|]
toWidget [lucius|foo3{bar:baz}|] toWidget [lucius|foo3{bar:baz}|]
getStaticR :: Handler RepHtml getStaticR :: Handler Html
getStaticR = getRootR getStaticR = getRootR
runner :: Session () -> IO () runner :: Session () -> IO ()

4
yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
View File

@ -18,10 +18,10 @@ getSubsite _ = Subsite $(mkYesodSubDispatch resourcesSubsite)
getBarR :: Monad m => m T.Text getBarR :: Monad m => m T.Text
getBarR = return $ T.pack "BarR" getBarR = return $ T.pack "BarR"
getBazR :: Yesod master => HandlerT Subsite (HandlerT master IO) RepHtml getBazR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
getBazR = lift $ defaultLayout [whamlet|Used Default Layout|] getBazR = lift $ defaultLayout [whamlet|Used Default Layout|]
getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) RepHtml getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
getBinR = do getBinR = do
widget <- widgetToParentWidget [whamlet| widget <- widgetToParentWidget [whamlet|
<p>Used defaultLayoutT <p>Used defaultLayoutT

10
yesod-core/test/YesodCoreTest/Widget.hs
View File

@ -31,7 +31,7 @@ mkYesod "Y" [parseRoutes|
instance Yesod Y where instance Yesod Y where
approot = ApprootStatic "http://test" approot = ApprootStatic "http://test"
getRootR :: Handler RepHtml getRootR :: Handler Html
getRootR = defaultLayout $ toWidgetBody [julius|<not escaped>|] getRootR = defaultLayout $ toWidgetBody [julius|<not escaped>|]
getMultiR :: [String] -> Handler () getMultiR :: [String] -> Handler ()
@ -46,7 +46,7 @@ instance RenderMessage Y Msg where
renderMessage a (_:xs) y = renderMessage a xs y renderMessage a (_:xs) y = renderMessage a xs y
renderMessage a [] y = renderMessage a ["en"] y renderMessage a [] y = renderMessage a ["en"] y
getTowidgetR :: Handler RepHtml getTowidgetR :: Handler Html
getTowidgetR = defaultLayout $ do getTowidgetR = defaultLayout $ do
toWidget [julius|foo|] :: Widget toWidget [julius|foo|] :: Widget
toWidgetHead [julius|foo|] toWidgetHead [julius|foo|]
@ -59,7 +59,7 @@ getTowidgetR = defaultLayout $ do
toWidgetHead [hamlet|<foo>|] toWidgetHead [hamlet|<foo>|]
toWidgetBody [hamlet|<foo>|] toWidgetBody [hamlet|<foo>|]
getWhamletR :: Handler RepHtml getWhamletR :: Handler Html
getWhamletR = defaultLayout [whamlet| getWhamletR = defaultLayout [whamlet|
$newline never $newline never
<h1>Test <h1>Test
@ -74,7 +74,7 @@ getWhamletR = defaultLayout [whamlet|
<h4>Embed <h4>Embed
|] |]
getAutoR :: Handler RepHtml getAutoR :: Handler Html
getAutoR = defaultLayout [whamlet| getAutoR = defaultLayout [whamlet|
$newline never $newline never
^{someHtml} ^{someHtml}
@ -82,7 +82,7 @@ $newline never
where where
someHtml = [shamlet|somehtml|] someHtml = [shamlet|somehtml|]
getJSHeadR :: Handler RepHtml getJSHeadR :: Handler Html
getJSHeadR = defaultLayout $ toWidgetHead [julius|alert("hello");|] getJSHeadR = defaultLayout $ toWidgetHead [julius|alert("hello");|]
widgetTest :: Spec widgetTest :: Spec