Skip to content

Commit

Permalink
Merge pull request #343 from scotty-web/MonadReader
Browse files Browse the repository at this point in the history
 MonadReader r m => MonadReader r (ActionT m) (fixes #342)
  • Loading branch information
fumieval authored Oct 21, 2023
2 parents 4e04c63 + f23db34 commit e911b6b
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 4 deletions.
12 changes: 8 additions & 4 deletions Web/Scotty/Internal/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions changelog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand Down

0 comments on commit e911b6b

Please sign in to comment.