yesod-core 1.2.1 → 1.2.2
raw patch · 14 files changed
+87/−25 lines, 14 files
Files
- Yesod/Core.hs +34/−0
- Yesod/Core/Class/Yesod.hs +2/−2
- Yesod/Core/Handler.hs +19/−1
- Yesod/Core/Types.hs +1/−0
- Yesod/Core/Widget.hs +11/−1
- test/YesodCoreTest/Auth.hs +1/−1
- test/YesodCoreTest/ErrorHandling.hs +4/−4
- test/YesodCoreTest/JsLoader.hs +1/−1
- test/YesodCoreTest/JsLoaderSites/Bottom.hs +1/−2
- test/YesodCoreTest/Links.hs +3/−3
- test/YesodCoreTest/Media.hs +2/−2
- test/YesodCoreTest/NoOverloadedStrings.hs +2/−2
- test/YesodCoreTest/Widget.hs +5/−5
- yesod-core.cabal +1/−1
Yesod/Core.hs view
@@ -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
Yesod/Core/Class/Yesod.hs view
@@ -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 <html>
Yesod/Core/Handler.hs view
@@ -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]
Yesod/Core/Types.hs view
@@ -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
Yesod/Core/Widget.hs view
@@ -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
test/YesodCoreTest/Auth.hs view
@@ -35,7 +35,7 @@ handleNeedsLoginJsonR :: Handler RepJson handleNeedsLoginJsonR = return $ repJson $ object []-handleNeedsLoginHtmlR :: Handler RepHtml+handleNeedsLoginHtmlR :: Handler Html handleNeedsLoginHtmlR = return "" test :: String -- ^ method
test/YesodCoreTest/ErrorHandling.hs view
@@ -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 @@ <input type=submit value="BUGGY: Error thrown after runRequestBody"> |] -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
test/YesodCoreTest/JsLoader.hs view
@@ -17,7 +17,7 @@ instance Yesod H where jsLoader _ = BottomOfHeadBlocking -getHeadR :: Handler RepHtml+getHeadR :: Handler Html getHeadR = defaultLayout $ addScriptRemote "load.js" specs :: Spec
test/YesodCoreTest/JsLoaderSites/Bottom.hs view
@@ -12,6 +12,5 @@ instance Yesod B where jsLoader _ = BottomOfBody -getBottomR :: Handler RepHtml+getBottomR :: Handler Html getBottomR = defaultLayout $ addScriptRemote "load.js"-
test/YesodCoreTest/Links.hs view
@@ -36,13 +36,13 @@ instance Yesod Y -getRootR :: Handler RepHtml+getRootR :: Handler Html getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|] -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 ()
test/YesodCoreTest/Media.hs view
@@ -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 ()
test/YesodCoreTest/NoOverloadedStrings.hs view
@@ -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| <p>Used defaultLayoutT
test/YesodCoreTest/Widget.hs view
@@ -31,7 +31,7 @@ instance Yesod Y where approot = ApprootStatic "http://test" -getRootR :: Handler RepHtml+getRootR :: Handler Html getRootR = defaultLayout $ toWidgetBody [julius|<not escaped>|] 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|<foo>|] toWidgetBody [hamlet|<foo>|] -getWhamletR :: Handler RepHtml+getWhamletR :: Handler Html getWhamletR = defaultLayout [whamlet| $newline never <h1>Test@@ -74,7 +74,7 @@ <h4>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
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.2.1+version: 1.2.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>