diff --git a/servant-server/CHANGELOG.md b/servant-server/CHANGELOG.md index 920dd6d4..90cd02f3 100644 --- a/servant-server/CHANGELOG.md +++ b/servant-server/CHANGELOG.md @@ -3,6 +3,11 @@ Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions. +Unreleased +---------- + +- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545) + 0.19 ---- diff --git a/servant-server/src/Servant/Server/Internal/Handler.hs b/servant-server/src/Servant/Server/Internal/Handler.hs index 67f4396a..40c83f81 100644 --- a/servant-server/src/Servant/Server/Internal/Handler.hs +++ b/servant-server/src/Servant/Server/Internal/Handler.hs @@ -13,17 +13,19 @@ import Control.Monad.Base import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Error.Class - (MonadError) + (MonadError, throwError) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Except (ExceptT, runExceptT) +import Data.String + (fromString) import GHC.Generics (Generic) import Servant.Server.Internal.ServerError - (ServerError) + (ServerError, errBody, err500) newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a } deriving @@ -32,6 +34,9 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a } , MonadThrow, MonadCatch, MonadMask ) +instance MonadFail Handler where + fail str = throwError err500 { errBody = fromString str } + instance MonadBase IO Handler where liftBase = Handler . liftBase