diff --git a/Yesod/Core.hs b/Yesod/Core.hs --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -78,6 +78,26 @@ , MonadBaseControl , MonadResource (..) , MonadLogger + -- * Commonly referenced functions/datatypes + , Application + -- * Utilities + , showIntegral + , readIntegral + -- * Shakespeare + -- ** Hamlet + , hamlet + , shamlet + , xhamlet + , HtmlUrl + -- ** Julius + , julius + , JavascriptUrl + , renderJavascriptUrl + -- ** Cassius/Lucius + , cassius + , lucius + , CssUrl + , renderCssUrl ) where import Yesod.Core.Content @@ -108,6 +128,11 @@ import Control.Monad.Trans.Resource (MonadResource (..)) import Yesod.Core.Internal.LiteApp +import Text.Hamlet +import Text.Cassius +import Text.Lucius +import Text.Julius +import Network.Wai (Application) -- | Return an 'Unauthorized' value, with the given i18n message. unauthorizedI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> m AuthResult @@ -137,3 +162,12 @@ => WidgetT child IO () -> HandlerT child (HandlerT parent IO) Html defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout + +showIntegral :: Integral a => a -> String +showIntegral x = show (fromIntegral x :: Integer) + +readIntegral :: Num a => String -> Maybe a +readIntegral s = + case reads s of + (i, _):_ -> Just $ fromInteger i + [] -> Nothing diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs @@ -83,11 +83,11 @@ errorHandler = defaultErrorHandler -- | 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 p <- widgetToPageContent w mmsg <- getMessage - hamletToRepHtml [hamlet| + giveUrlRenderer [hamlet| $newline never $doctype 5 diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs @@ -49,11 +49,13 @@ , lookupPostParam , lookupCookie , lookupFile + , lookupHeader -- **** Multi-lookup , lookupGetParams , lookupPostParams , lookupCookies , lookupFiles + , lookupHeaders -- * Responses -- ** Pure , respond @@ -191,6 +193,7 @@ import Control.Failure (failure) import Blaze.ByteString.Builder (Builder) import Safe (headMay) +import Data.CaseInsensitive (CI) get :: MonadHandler m => m GHState get = liftHandlerT $ HandlerT $ I.readIORef . handlerState @@ -707,7 +710,7 @@ -> m a redirectToPost url = do urlText <- toTextUrl url - hamletToRepHtml [hamlet| + giveUrlRenderer [hamlet| $newline never $doctype 5 @@ -724,6 +727,7 @@ -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html hamletToRepHtml = giveUrlRenderer +{-# DEPRECATED hamletToRepHtml "Use giveUrlRenderer instead" #-} -- | Provide a URL rendering function to the given function and return the -- result. Useful for processing Shakespearean templates. @@ -798,6 +802,20 @@ lookup' :: Eq a => a -> [(a, b)] -> [b] lookup' a = map snd . filter (\x -> a == fst x) + +-- | Lookup a request header. +-- +-- Since 1.2.2 +lookupHeader :: MonadHandler m => CI S8.ByteString -> m (Maybe S8.ByteString) +lookupHeader = liftM listToMaybe . lookupHeaders + +-- | Lookup a request header. +-- +-- Since 1.2.2 +lookupHeaders :: MonadHandler m => CI S8.ByteString -> m [S8.ByteString] +lookupHeaders key = do + req <- waiRequest + return $ lookup' key $ W.requestHeaders req -- | Lookup for GET parameters. lookupGetParams :: MonadHandler m => Text -> m [Text] diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs --- a/Yesod/Core/Types.hs +++ b/Yesod/Core/Types.hs @@ -266,6 +266,7 @@ data TypedContent = TypedContent !ContentType !Content type RepHtml = Html +{-# DEPRECATED RepHtml "Please use Html instead" #-} newtype RepJson = RepJson Content newtype RepPlain = RepPlain Content newtype RepXml = RepXml Content diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs --- a/Yesod/Core/Widget.hs +++ b/Yesod/Core/Widget.hs @@ -19,6 +19,7 @@ , whamlet , whamletFile , ihamletToRepHtml + , ihamletToHtml -- * Convert to Widget , ToWidget (..) , ToWidgetHead (..) @@ -220,7 +221,16 @@ ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -> 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 mrender <- getMessageRender return $ ih (toHtml . mrender) urender diff --git a/test/YesodCoreTest/Auth.hs b/test/YesodCoreTest/Auth.hs --- a/test/YesodCoreTest/Auth.hs +++ b/test/YesodCoreTest/Auth.hs @@ -35,7 +35,7 @@ handleNeedsLoginJsonR :: Handler RepJson handleNeedsLoginJsonR = return $ repJson $ object [] -handleNeedsLoginHtmlR :: Handler RepHtml +handleNeedsLoginHtmlR :: Handler Html handleNeedsLoginHtmlR = return "" test :: String -- ^ method diff --git a/test/YesodCoreTest/ErrorHandling.hs b/test/YesodCoreTest/ErrorHandling.hs --- a/test/YesodCoreTest/ErrorHandling.hs +++ b/test/YesodCoreTest/ErrorHandling.hs @@ -26,7 +26,7 @@ instance Yesod App -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do $logDebug "Testing logging" defaultLayout $ toWidget [hamlet| @@ -42,7 +42,7 @@ |] -postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler RepHtml +postNotFoundR, postFirstThingR, postAfterRunRequestBodyR :: Handler Html postNotFoundR = do (_, _files) <- runRequestBody _ <- notFound @@ -57,12 +57,12 @@ _ <- error $ show $ fst x getHomeR -getErrorInBodyR :: Handler RepHtml +getErrorInBodyR :: Handler Html getErrorInBodyR = do let foo = error "error in body 19328" :: String defaultLayout [whamlet|#{foo}|] -getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate RepHtml) +getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate Html) getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR errorHandlingTest :: Spec diff --git a/test/YesodCoreTest/JsLoader.hs b/test/YesodCoreTest/JsLoader.hs --- a/test/YesodCoreTest/JsLoader.hs +++ b/test/YesodCoreTest/JsLoader.hs @@ -17,7 +17,7 @@ instance Yesod H where jsLoader _ = BottomOfHeadBlocking -getHeadR :: Handler RepHtml +getHeadR :: Handler Html getHeadR = defaultLayout $ addScriptRemote "load.js" specs :: Spec diff --git a/test/YesodCoreTest/JsLoaderSites/Bottom.hs b/test/YesodCoreTest/JsLoaderSites/Bottom.hs --- a/test/YesodCoreTest/JsLoaderSites/Bottom.hs +++ b/test/YesodCoreTest/JsLoaderSites/Bottom.hs @@ -12,6 +12,5 @@ instance Yesod B where jsLoader _ = BottomOfBody -getBottomR :: Handler RepHtml +getBottomR :: Handler Html getBottomR = defaultLayout $ addScriptRemote "load.js" - diff --git a/test/YesodCoreTest/Links.hs b/test/YesodCoreTest/Links.hs --- a/test/YesodCoreTest/Links.hs +++ b/test/YesodCoreTest/Links.hs @@ -36,13 +36,13 @@ instance Yesod Y -getRootR :: Handler RepHtml +getRootR :: Handler Html getRootR = defaultLayout $ toWidget [hamlet||] -getTextR :: Text -> Handler RepHtml +getTextR :: Text -> Handler Html getTextR foo = defaultLayout $ toWidget [hamlet|%#{foo}%|] -getTextsR :: [Text] -> Handler RepHtml +getTextsR :: [Text] -> Handler Html getTextsR foos = defaultLayout $ toWidget [hamlet|%#{show foos}%|] getRT1 :: [Text] -> Handler () diff --git a/test/YesodCoreTest/Media.hs b/test/YesodCoreTest/Media.hs --- a/test/YesodCoreTest/Media.hs +++ b/test/YesodCoreTest/Media.hs @@ -23,13 +23,13 @@ else "all.css" _ -> return Nothing -getRootR :: Handler RepHtml +getRootR :: Handler Html getRootR = defaultLayout $ do toWidget [lucius|foo1{bar:baz}|] toWidgetMedia "screen" [lucius|foo2{bar:baz}|] toWidget [lucius|foo3{bar:baz}|] -getStaticR :: Handler RepHtml +getStaticR :: Handler Html getStaticR = getRootR runner :: Session () -> IO () diff --git a/test/YesodCoreTest/NoOverloadedStrings.hs b/test/YesodCoreTest/NoOverloadedStrings.hs --- a/test/YesodCoreTest/NoOverloadedStrings.hs +++ b/test/YesodCoreTest/NoOverloadedStrings.hs @@ -18,10 +18,10 @@ getBarR :: Monad m => m T.Text 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|] -getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) RepHtml +getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html getBinR = do widget <- widgetToParentWidget [whamlet|

Used defaultLayoutT diff --git a/test/YesodCoreTest/Widget.hs b/test/YesodCoreTest/Widget.hs --- a/test/YesodCoreTest/Widget.hs +++ b/test/YesodCoreTest/Widget.hs @@ -31,7 +31,7 @@ instance Yesod Y where approot = ApprootStatic "http://test" -getRootR :: Handler RepHtml +getRootR :: Handler Html getRootR = defaultLayout $ toWidgetBody [julius||] getMultiR :: [String] -> Handler () @@ -46,7 +46,7 @@ renderMessage a (_:xs) y = renderMessage a xs y renderMessage a [] y = renderMessage a ["en"] y -getTowidgetR :: Handler RepHtml +getTowidgetR :: Handler Html getTowidgetR = defaultLayout $ do toWidget [julius|foo|] :: Widget toWidgetHead [julius|foo|] @@ -59,7 +59,7 @@ toWidgetHead [hamlet||] toWidgetBody [hamlet||] -getWhamletR :: Handler RepHtml +getWhamletR :: Handler Html getWhamletR = defaultLayout [whamlet| $newline never

Test @@ -74,7 +74,7 @@

Embed |] -getAutoR :: Handler RepHtml +getAutoR :: Handler Html getAutoR = defaultLayout [whamlet| $newline never ^{someHtml} @@ -82,7 +82,7 @@ where someHtml = [shamlet|somehtml|] -getJSHeadR :: Handler RepHtml +getJSHeadR :: Handler Html getJSHeadR = defaultLayout $ toWidgetHead [julius|alert("hello");|] widgetTest :: Spec diff --git a/yesod-core.cabal b/yesod-core.cabal --- a/yesod-core.cabal +++ b/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.1 +version: 1.2.2 license: MIT license-file: LICENSE author: Michael Snoyman