yesod-core 1.4.25 → 1.4.26

raw patch · 3 files changed

+10/−2 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Yesod.Core.Handler: instance (GHC.Show.Show b, GHC.Show.Show a) => GHC.Show.Show (Yesod.Core.Handler.Fragment a b)

+ Yesod.Core.Handler: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Yesod.Core.Handler.Fragment a b)

- Yesod.Core: class RenderRoute site => Yesod site where approot = ApprootRelative errorHandler = defaultErrorHandler defaultLayout w = do { p <- widgetToPageContent w; msgs <- getMessages; withUrlRenderer (\ _render_a1hoc -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\n\ \<html><head><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_a1hoc; id ((preEscapedText . pack) "</head><body>"); mapM_ (\ (status_a1hod, msg_a1hoe) -> do { id ((preEscapedText . pack) "<p class=\"message "); id (toHtml status_a1hod); id ((preEscapedText . pack) "\">"); id (toHtml msg_a1hoe); id ((preEscapedText . pack) "</p>") }) msgs; asHtmlUrl (pageBody p) _render_a1hoc; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing urlParamRenderOverride y route params = addParams params <$> urlRenderOverride y route where addParams [] routeBldr = routeBldr addParams nonEmptyParams routeBldr = let routeBS = toByteString routeBldr qsSeparator = fromChar $ if elem '?' routeBS then '&' else '?' valueToMaybe t = if t == "" then Nothing else Just t queryText = map (id *** valueToMaybe) nonEmptyParams in copyByteString routeBS `mappend` qsSeparator `mappend` renderQueryText False queryText isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ W.requestMethod wai `notElem` ["GET", "HEAD", "OPTIONS", "TRACE"] } authRoute _ = Nothing cleanPath _ s = if corrected == s then Right $ map dropDash s else Left corrected where corrected = filter (not . null) s dropDash t | all (== '-') t = drop 1 t | otherwise = t joinPath _ ar pieces' qs' = fromText ar `mappend` encodePath pieces qs where pieces = if null pieces' then [""] else map addDash pieces' qs = map (encodeUtf8 *** go) qs' go "" = Nothing go x = Just $ encodeUtf8 x addDash t | all (== '-') t = cons '-' t | otherwise = t addStaticContent _ _ _ = return Nothing maximumContentLength _ _ = Just $ 2 * 1024 * 1024 makeLogger _ = defaultMakeLogger messageLoggerSource site = defaultMessageLoggerSource $ shouldLogIO site jsLoader _ = BottomOfBody makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 defaultKeyFile fileUpload _ (KnownLength size) | size <= 50000 = FileUploadMemory lbsBackEnd fileUpload _ _ = FileUploadDisk tempFileBackEnd shouldLog _ = defaultShouldLog shouldLogIO a b c = return (shouldLog a b c) yesodMiddleware = defaultYesodMiddleware yesodWithInternalState _ _ = bracket createInternalState closeInternalState

+ Yesod.Core: class RenderRoute site => Yesod site where approot = ApprootRelative errorHandler = defaultErrorHandler defaultLayout w = do { p <- widgetToPageContent w; msgs <- getMessages; withUrlRenderer (\ _render_a2PWd -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\n\ \<html><head><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_a2PWd; id ((preEscapedText . pack) "</head><body>"); mapM_ (\ (status_a2PWe, msg_a2PWf) -> do { id ((preEscapedText . pack) "<p class=\"message "); id (toHtml status_a2PWe); id ((preEscapedText . pack) "\">"); id (toHtml msg_a2PWf); id ((preEscapedText . pack) "</p>") }) msgs; asHtmlUrl (pageBody p) _render_a2PWd; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing urlParamRenderOverride y route params = addParams params <$> urlRenderOverride y route where addParams [] routeBldr = routeBldr addParams nonEmptyParams routeBldr = let routeBS = toByteString routeBldr qsSeparator = fromChar $ if elem '?' routeBS then '&' else '?' valueToMaybe t = if t == "" then Nothing else Just t queryText = map (id *** valueToMaybe) nonEmptyParams in copyByteString routeBS `mappend` qsSeparator `mappend` renderQueryText False queryText isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ W.requestMethod wai `notElem` ["GET", "HEAD", "OPTIONS", "TRACE"] } authRoute _ = Nothing cleanPath _ s = if corrected == s then Right $ map dropDash s else Left corrected where corrected = filter (not . null) s dropDash t | all (== '-') t = drop 1 t | otherwise = t joinPath _ ar pieces' qs' = fromText ar `mappend` encodePath pieces qs where pieces = if null pieces' then [""] else map addDash pieces' qs = map (encodeUtf8 *** go) qs' go "" = Nothing go x = Just $ encodeUtf8 x addDash t | all (== '-') t = cons '-' t | otherwise = t addStaticContent _ _ _ = return Nothing maximumContentLength _ _ = Just $ 2 * 1024 * 1024 makeLogger _ = defaultMakeLogger messageLoggerSource site = defaultMessageLoggerSource $ shouldLogIO site jsLoader _ = BottomOfBody makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 defaultKeyFile fileUpload _ (KnownLength size) | size <= 50000 = FileUploadMemory lbsBackEnd fileUpload _ _ = FileUploadDisk tempFileBackEnd shouldLog _ = defaultShouldLog shouldLogIO a b c = return (shouldLog a b c) yesodMiddleware = defaultYesodMiddleware yesodWithInternalState _ _ = bracket createInternalState closeInternalState

- Yesod.Core: lift :: (MonadTrans t, Monad m) => m a -> t m a

+ Yesod.Core: lift :: Monad m => m a -> t m a

- Yesod.Core: liftBase :: MonadBase b m => b α -> m α

+ Yesod.Core: liftBase :: b α -> m α

- Yesod.Core: liftIO :: MonadIO m => IO a -> m a

+ Yesod.Core: liftIO :: IO a -> m a

- Yesod.Core: liftResourceT :: MonadResource m => ResourceT IO a -> m a

+ Yesod.Core: liftResourceT :: ResourceT IO a -> m a

- Yesod.Core.Dispatch: fromPathMultiPiece :: PathMultiPiece s => [Text] -> Maybe s

+ Yesod.Core.Dispatch: fromPathMultiPiece :: [Text] -> Maybe s

- Yesod.Core.Dispatch: fromPathPiece :: PathPiece s => Text -> Maybe s

+ Yesod.Core.Dispatch: fromPathPiece :: Text -> Maybe s

- Yesod.Core.Dispatch: toPathMultiPiece :: PathMultiPiece s => s -> [Text]

+ Yesod.Core.Dispatch: toPathMultiPiece :: s -> [Text]

- Yesod.Core.Dispatch: toPathPiece :: PathPiece s => s -> Text

+ Yesod.Core.Dispatch: toPathPiece :: s -> Text

- Yesod.Core.Json: parseJSON :: FromJSON a => Value -> Parser a

+ Yesod.Core.Json: parseJSON :: Value -> Parser a

- Yesod.Core.Json: parseJSONList :: FromJSON a => Value -> Parser [a]

+ Yesod.Core.Json: parseJSONList :: Value -> Parser [a]

- Yesod.Core.Json: toEncoding :: ToJSON a => a -> Encoding

+ Yesod.Core.Json: toEncoding :: a -> Encoding

- Yesod.Core.Json: toEncodingList :: ToJSON a => [a] -> Encoding

+ Yesod.Core.Json: toEncodingList :: [a] -> Encoding

- Yesod.Core.Json: toJSON :: ToJSON a => a -> Value

+ Yesod.Core.Json: toJSON :: a -> Value

- Yesod.Core.Json: toJSONList :: ToJSON a => [a] -> Value

+ Yesod.Core.Json: toJSONList :: [a] -> Value

Files

ChangeLog.md +5/−0
Yesod/Core/Handler.hs +4/−1
yesod-core.cabal +1/−1

ChangeLog.md view

@@ -1,3 +1,8 @@+## 1.4.26++* Modify `languages` so that, if you previously called `setLanguage`, the newly+  set language will be reflected.+ ## 1.4.25  * Add instance of MonadHandler and MonadWidget for ExceptT [#1278](https://github.com/yesodweb/yesod/pull/1278)

Yesod/Core/Handler.hs view

@@ -1053,7 +1053,10 @@ -- -- This is handled by parseWaiRequest (not exposed). languages :: MonadHandler m => m [Text]-languages = reqLangs <$> getRequest+languages = do+    mlang <- lookupSession langKey+    langs <- reqLangs <$> getRequest+    return $ maybe id (:) mlang langs  lookup' :: Eq a => a -> [(a, b)] -> [b] lookup' a = map snd . filter (\x -> a == fst x)

yesod-core.cabal view

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.4.25+version:         1.4.26 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>