yesod-core 1.2.9.2 → 1.2.10
raw patch · 3 files changed
+30/−5 lines, 3 filesdep +mtl
Dependencies added: mtl
Files
- Yesod/Core/Dispatch.hs +9/−0
- Yesod/Core/Types.hs +19/−4
- yesod-core.cabal +2/−1
Yesod/Core/Dispatch.hs view
@@ -64,6 +64,7 @@ import qualified Network.Wai.Handler.Warp import System.Log.FastLogger import Control.Monad.Logger+import Control.Monad (when) import qualified Paths_yesod_core import Data.Version (showVersion) @@ -163,6 +164,7 @@ ] -} , Network.Wai.Handler.Warp.settingsOnException = const $ \e ->+ when (shouldLog' e) $ messageLoggerSource site logger@@ -171,6 +173,13 @@ LevelError (toLogStr $ "Exception from Warp: " ++ show e) }+ where+ shouldLog' =+#if MIN_VERSION_wai(2,1,3)+ Warp.defaultShouldDisplayException+#else+ const True+#endif -- | A default set of middlewares. --
Yesod/Core/Types.hs view
@@ -61,6 +61,7 @@ import Yesod.Core.Internal.Util (getTime, putTime) import Control.Monad.Trans.Class (MonadTrans (..)) import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..))+import Control.Monad.Reader (MonadReader (..)) -- Sessions type SessionMap = Map Text ByteString@@ -386,11 +387,18 @@ liftBase = WidgetT . const . liftBase . fmap (, mempty) instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site)))- liftBaseWith f = WidgetT $ \reader ->+ liftBaseWith f = WidgetT $ \reader' -> liftBaseWith $ \runInBase -> liftM (\x -> (x, mempty))- (f $ liftM StW . runInBase . flip unWidgetT reader)+ (f $ liftM StW . runInBase . flip unWidgetT reader') restoreM (StW base) = WidgetT $ const $ restoreM base+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+ { handlerEnv = (handlerEnv hd)+ { rheSite = f $ rheSite $ handlerEnv hd+ }+ } instance MonadTrans (WidgetT site) where lift = WidgetT . const . liftM (, mempty)@@ -428,6 +436,13 @@ liftIO = lift . liftIO instance MonadBase b m => MonadBase b (HandlerT site m) where liftBase = lift . liftBase+instance Monad m => MonadReader site (HandlerT site m) where+ ask = HandlerT $ return . rheSite . handlerEnv+ local f (HandlerT g) = HandlerT $ \hd -> g hd+ { handlerEnv = (handlerEnv hd)+ { rheSite = f $ rheSite $ handlerEnv hd+ }+ } -- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s -- @fork@ function is incompatible with the underlying @ResourceT@ system. -- Instead, if you must fork a separate thread, you should use@@ -438,9 +453,9 @@ -- after cleanup. Please contact the maintainers.\" instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where data StM (HandlerT site m) a = StH (StM m a)- liftBaseWith f = HandlerT $ \reader ->+ liftBaseWith f = HandlerT $ \reader' -> liftBaseWith $ \runInBase ->- f $ liftM StH . runInBase . (\(HandlerT r) -> r reader)+ f $ liftM StH . runInBase . (\(HandlerT r) -> r reader') restoreM (StH base) = HandlerT $ const $ restoreM base instance MonadThrow m => MonadThrow (HandlerT site m) where
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.2.9.2+version: 1.2.10 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -39,6 +39,7 @@ , shakespeare-i18n >= 1.0 , blaze-builder >= 0.2.1.4 && < 0.4 , transformers >= 0.2.2 && < 0.4+ , mtl , clientsession >= 0.9 && < 0.10 , random >= 1.0.0.2 && < 1.1 , cereal >= 0.3