yesod-core 1.4.6.1 → 1.4.6.2
raw patch · 4 files changed
+25/−4 lines, 4 filesdep ~monad-controlPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: monad-control
API changes (from Hackage documentation)
- Yesod.Core: class RenderRoute site => Yesod site where approot = ApprootRelative errorHandler = defaultErrorHandler defaultLayout w = do { p <- widgetToPageContent w; mmsg <- getMessage; withUrlRenderer (\ _render_a11uL -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\n\ \<html><head><style type="text/css">#synopsis details:not([open]) > ul { visibility: hidden; }</style><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_a11uL; id ((preEscapedText . pack) "</head><body>"); maybeH mmsg (\ msg_a11uM -> do { id ((preEscapedText . pack) "<p class=\"message\">"); id (toHtml msg_a11uM); id ((preEscapedText . pack) "</p>") }) Nothing; asHtmlUrl (pageBody p) _render_a11uL; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ 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 _ = do { loggerSet' <- newStdoutLoggerSet defaultBufSize; (getter, _) <- clockDateCacher; return $! Logger loggerSet' getter } messageLoggerSource a logger loc source level msg = do { sl <- shouldLogIO a source level; when sl $ formatLogMessage (loggerDate logger) loc source level msg >>= loggerPutStr logger } jsLoader _ = BottomOfBody makeSessionBackend _ = fmap Just $ defaultClientSessionBackend 120 defaultKeyFile fileUpload _ (KnownLength size) | size <= 50000 = FileUploadMemory lbsBackEnd fileUpload _ _ = FileUploadDisk tempFileBackEnd shouldLog _ _ level = level >= LevelInfo 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; mmsg <- getMessage; withUrlRenderer (\ _render_a11ld -> do { id ((preEscapedText . pack) "<!DOCTYPE html>\n\ \<html><head><style type="text/css">#synopsis details:not([open]) > ul { visibility: hidden; }</style><title>"); id (toHtml (pageTitle p)); id ((preEscapedText . pack) "</title>"); asHtmlUrl (pageHead p) _render_a11ld; id ((preEscapedText . pack) "</head><body>"); maybeH mmsg (\ msg_a11le -> do { id ((preEscapedText . pack) "<p class=\"message\">"); id (toHtml msg_a11le); id ((preEscapedText . pack) "</p>") }) Nothing; asHtmlUrl (pageBody p) _render_a11ld; id ((preEscapedText . pack) "</body></html>") }) } urlRenderOverride _ _ = Nothing isAuthorized _ _ = return Authorized isWriteRequest _ = do { wai <- waiRequest; return $ 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 _ = do { loggerSet' <- newStdoutLoggerSet defaultBufSize; (getter, _) <- clockDateCacher; return $! Logger loggerSet' getter } messageLoggerSource a logger loc source level msg = do { sl <- shouldLogIO a source level; when sl $ formatLogMessage (loggerDate logger) loc source level msg >>= loggerPutStr logger } jsLoader _ = BottomOfBody makeSessionBackend _ = fmap Just $ defaultClientSessionBackend 120 defaultKeyFile fileUpload _ (KnownLength size) | size <= 50000 = FileUploadMemory lbsBackEnd fileUpload _ _ = FileUploadDisk tempFileBackEnd shouldLog _ _ level = level >= LevelInfo shouldLogIO a b c = return (shouldLog a b c) yesodMiddleware = defaultYesodMiddleware yesodWithInternalState _ _ = bracket createInternalState closeInternalState
Files
- ChangeLog.md +4/−0
- Yesod/Core/Handler.hs +2/−2
- Yesod/Core/Types.hs +17/−0
- yesod-core.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.4.6.2++monad-control 1.0+ ## 1.4.6 Added the `Yesod.Core.Unsafe` module.
Yesod/Core/Handler.hs view
@@ -567,7 +567,7 @@ => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ()) -> m a sendRawResponseNoConduit raw = control $ \runInIO ->- runInIO $ sendWaiResponse $ flip W.responseRaw fallback+ liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback $ \src sink -> runInIO (raw src sink) >> return () where fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]@@ -582,7 +582,7 @@ => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ()) -> m a sendRawResponse raw = control $ \runInIO ->- runInIO $ sendWaiResponse $ flip W.responseRaw fallback+ liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback $ \src sink -> runInIO (raw (src' src) (CL.mapM_ sink)) >> return () where fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")]
Yesod/Core/Types.hs view
@@ -396,12 +396,21 @@ instance MonadBase b m => MonadBase b (WidgetT site m) where liftBase = WidgetT . const . liftBase . fmap (, mempty) instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where+#if MIN_VERSION_monad_control(1,0,0)+ type StM (WidgetT site m) a = StM m (a, GWData (Route site))+ liftBaseWith f = WidgetT $ \reader' ->+ liftBaseWith $ \runInBase ->+ liftM (\x -> (x, mempty))+ (f $ runInBase . flip unWidgetT reader')+ restoreM = WidgetT . const . restoreM+#else data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site))) liftBaseWith f = WidgetT $ \reader' -> liftBaseWith $ \runInBase -> liftM (\x -> (x, mempty)) (f $ liftM StW . runInBase . flip unWidgetT reader') restoreM (StW base) = WidgetT $ const $ restoreM base+#endif instance Monad m => MonadReader site (WidgetT site m) where ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty) local f (WidgetT g) = WidgetT $ \hd -> g hd@@ -481,11 +490,19 @@ -- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed -- after cleanup. Please contact the maintainers.\" instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where+#if MIN_VERSION_monad_control(1,0,0)+ type StM (HandlerT site m) a = StM m a+ liftBaseWith f = HandlerT $ \reader' ->+ liftBaseWith $ \runInBase ->+ f $ runInBase . (\(HandlerT r) -> r reader')+ restoreM = HandlerT . const . restoreM+#else data StM (HandlerT site m) a = StH (StM m a) liftBaseWith f = HandlerT $ \reader' -> liftBaseWith $ \runInBase -> f $ liftM StH . runInBase . (\(HandlerT r) -> r reader') restoreM (StH base) = HandlerT $ const $ restoreM base+#endif instance MonadThrow m => MonadThrow (HandlerT site m) where throwM = lift . monadThrow
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.4.6.1+version: 1.4.6.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -40,7 +40,7 @@ , old-locale >= 1.0.0.2 && < 1.1 , containers >= 0.2 , unordered-containers >= 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , transformers-base >= 0.4 , cookie >= 0.4.1 && < 0.5 , http-types >= 0.7