From f23db348183b64985fe52781a8179512d8fe3a6c Mon Sep 17 00:00:00 2001 From: Fumiaki Kinoshita Date: Mon, 16 Oct 2023 18:09:58 +0900 Subject: [PATCH] MonadReader r m => MonadReader r (ActionT m) (fixes #342) --- Web/Scotty/Internal/Types.hs | 12 ++++++++---- changelog.md | 1 + 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index fdecedf6..baa2f5f4 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -21,7 +21,7 @@ import Control.Monad.Catch (MonadCatch, MonadThrow) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) -import Control.Monad.Reader (MonadReader(..), ReaderT, asks) +import Control.Monad.Reader (MonadReader(..), ReaderT, asks, mapReaderT) import Control.Monad.State.Strict (State, StateT(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Control (MonadBaseControl, MonadTransControl) @@ -170,12 +170,12 @@ getResponse ae = liftIO $ readTVarIO (envResponse ae) getResponseAction :: (MonadIO m) => ActionT m ScottyResponse getResponseAction = do - ae <- ask + ae <- ActionT ask getResponse ae modifyResponse :: (MonadIO m) => (ScottyResponse -> ScottyResponse) -> ActionT m () modifyResponse f = do - tv <- asks envResponse + tv <- ActionT $ asks envResponse liftIO $ atomically $ modifyTVar' tv f data BodyPartiallyStreamed = BodyPartiallyStreamed deriving (Show, Typeable) @@ -210,7 +210,11 @@ defaultScottyResponse = SR status200 [] (ContentBuilder mempty) newtype ActionT m a = ActionT { runAM :: ReaderT ActionEnv m a } - deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader ActionEnv, MonadTrans, MonadThrow, MonadCatch, MonadBase b, MonadBaseControl b, MonadTransControl, MonadUnliftIO) + deriving newtype (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadThrow, MonadCatch, MonadBase b, MonadBaseControl b, MonadTransControl, MonadUnliftIO) + +instance MonadReader r m => MonadReader r (ActionT m) where + ask = ActionT $ lift ask + local f = ActionT . mapReaderT (local f) . runAM -- | Models the invariant that only 'StatusError's can be thrown and caught. instance (MonadUnliftIO m) => MonadError StatusError (ActionT m) where diff --git a/changelog.md b/changelog.md index fa7a201a..5d8d3aa6 100644 --- a/changelog.md +++ b/changelog.md @@ -4,6 +4,7 @@ * add `captureParamMaybe`, `formParamMaybe`, `queryParamMaybe` (#322) * deprecate `rescue` and `liftAndCatchIO` * add `Web.Scotty.Trans.Strict` and `Web.Scotty.Trans.Lazy` +* Reverted the `MonadReader` instance of `ActionT` so that it inherits the base monad ## 0.20.1 [2023.10.03]