yesod-core 1.4.19 → 1.4.20
raw patch · 7 files changed
+77/−26 lines, 7 files
Files
- ChangeLog.md +8/−0
- Yesod/Core/Class/Yesod.hs +3/−3
- Yesod/Core/Handler.hs +60/−19
- Yesod/Core/Internal/Session.hs +1/−1
- Yesod/Routes/Parse.hs +2/−2
- test/Hierarchy.hs +2/−0
- yesod-core.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,11 @@+## 1.4.20++* `addMessage`, `addMessageI`, and `getMessages` functions++## 1.4.19.1++* Allow lines of dashes in route files [#1182](https://github.com/yesodweb/yesod/pull/1182)+ ## 1.4.19 * Auth logout not working with defaultCsrfMiddleware [#1151](https://github.com/yesodweb/yesod/issues/1151)
Yesod/Core/Class/Yesod.hs view
@@ -87,7 +87,7 @@ defaultLayout :: WidgetT site IO () -> HandlerT site IO Html defaultLayout w = do p <- widgetToPageContent w- mmsg <- getMessage+ msgs <- getMessages withUrlRenderer [hamlet| $newline never $doctype 5@@ -96,8 +96,8 @@ <title>#{pageTitle p} ^{pageHead p} <body>- $maybe msg <- mmsg- <p .message>#{msg}+ $forall (status, msg) <- msgs+ <p class="message #{status}">#{msg} ^{pageBody p} |]
Yesod/Core/Handler.hs view
@@ -136,6 +136,9 @@ , redirectUltDest , clearUltDest -- ** Messages+ , addMessage+ , addMessageI+ , getMessages , setMessage , setMessageI , getMessage@@ -205,7 +208,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as TL-import qualified Text.Blaze.Html.Renderer.Text as RenderText+import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.Hamlet (Html, HtmlUrl, hamlet) import qualified Data.ByteString as S@@ -223,7 +226,7 @@ import Web.Cookie (SetCookie (..)) import Yesod.Core.Content (ToTypedContent (..), simpleContentType, contentTypeTypes, HasContentType (..), ToContent (..), ToFlushBuilder (..)) import Yesod.Core.Internal.Util (formatRFC1123)-import Text.Blaze.Html (preEscapedToMarkup, toHtml)+import Text.Blaze.Html (preEscapedToHtml, toHtml) import qualified Data.IORef.Lifted as I import Data.Maybe (listToMaybe, mapMaybe)@@ -521,31 +524,67 @@ msgKey :: Text msgKey = "_MSG" --- | Sets a message in the user's session.+-- | Adds a status and message in the user's session. ----- See 'getMessage'.-setMessage :: MonadHandler m => Html -> m ()-setMessage = setSession msgKey . T.concat . TL.toChunks . RenderText.renderHtml+-- See 'getMessages'.+--+-- @since 1.4.20+addMessage :: MonadHandler m+ => Text -- ^ status+ -> Html -- ^ message+ -> m ()+addMessage status msg = do+ val <- lookupSessionBS msgKey+ setSessionBS msgKey $ addMsg val+ where+ addMsg = maybe msg' (S.append msg' . S.cons W8._nul)+ msg' = S.append+ (encodeUtf8 status)+ (W8._nul `S.cons` (L.toStrict $ renderHtml msg)) --- | Sets a message in the user's session.+-- | Adds a message in the user's session but uses RenderMessage to allow for i18n ----- See 'getMessage'.-setMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)- => msg -> m ()-setMessageI msg = do+-- See 'getMessages'.+--+-- @since 1.4.20+addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)+ => Text -> msg -> m ()+addMessageI status msg = do mr <- getMessageRender- setMessage $ toHtml $ mr msg+ addMessage status $ toHtml $ mr msg --- | Gets the message in the user's session, if available, and then clears the--- variable.+-- | Gets all messages in the user's session, and then clears the variable. ----- See 'setMessage'.-getMessage :: MonadHandler m => m (Maybe Html)-getMessage = do- mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession msgKey+-- See 'addMessage'.+--+-- @since 1.4.20+getMessages :: MonadHandler m => m [(Text, Html)]+getMessages = do+ bs <- lookupSessionBS msgKey+ let ms = maybe [] enlist bs deleteSession msgKey- return mmsg+ return ms+ where+ enlist = pairup . S.split W8._nul+ pairup [] = []+ pairup [x] = []+ pairup (s:v:xs) = (decode s, preEscapedToHtml (decode v)) : pairup xs+ decode = decodeUtf8With lenientDecode +-- | Calls 'addMessage' with an empty status+setMessage :: MonadHandler m => Html -> m ()+setMessage = addMessage ""++-- | Calls 'addMessageI' with an empty status+setMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)+ => msg -> m ()+setMessageI = addMessageI ""++-- | Gets just the last message in the user's session,+-- discards the rest and the status+getMessage :: MonadHandler m => m (Maybe Html)+getMessage = (return . fmap snd . headMay) =<< getMessages+ -- | Bypass remaining handler code and output the given file. -- -- For some backends, this is more efficient than reading in the file to@@ -580,6 +619,8 @@ -- | Bypass remaining handler code and output the given JSON with the given -- status code.+-- +-- Since 1.4.18 sendStatusJSON :: (MonadHandler m, ToJSON c) => H.Status -> c -> m a sendStatusJSON s v = sendResponseStatus s (toJSON v)
Yesod/Core/Internal/Session.hs view
@@ -55,7 +55,7 @@ -- to preserve the type. clientSessionDateCacher ::- NominalDiffTime -- ^ Inactive session valitity.+ NominalDiffTime -- ^ Inactive session validity. -> IO (IO ClientSessionDateCache, IO ()) clientSessionDateCacher validity = do getClientSessionDateCache <- mkAutoUpdate defaultUpdateSettings
Yesod/Routes/Parse.hs view
@@ -18,7 +18,7 @@ import qualified System.IO as SIO import Yesod.Routes.TH import Yesod.Routes.Overlap (findOverlapNames)-import Data.List (foldl')+import Data.List (foldl', isPrefixOf) import Data.Maybe (mapMaybe) import qualified Data.Set as Set @@ -86,7 +86,7 @@ spaces = takeWhile (== ' ') thisLine (others, remainder) = parse indent otherLines' (this, otherLines') =- case takeWhile (/= "--") $ words thisLine of+ case takeWhile (not . isPrefixOf "--") $ words thisLine of (pattern:rest0) | Just (constr:rest) <- stripColonLast rest0 , Just attrs <- mapM parseAttr rest ->
test/Hierarchy.hs view
@@ -78,6 +78,8 @@ let resources = [parseRoutes| / HomeR GET +----------------------------------------+ /!#Int BackwardsR GET /admin/#Int AdminR:
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.4.19+version: 1.4.20 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>