Merge pull request from hasufell/PR/hasufell/issue-1545/monad-fail

Add `MonadFail` instance for `Handler` wrt 
This commit is contained in:
Gaël Deest 2022-02-28 09:47:33 +01:00 committed by GitHub
commit 8fccfccae0
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 12 additions and 2 deletions
servant-server
CHANGELOG.md
src/Servant/Server/Internal

View file

@ -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. 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 0.19
---- ----

View file

@ -13,17 +13,19 @@ import Control.Monad.Base
import Control.Monad.Catch import Control.Monad.Catch
(MonadCatch, MonadMask, MonadThrow) (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Error.Class import Control.Monad.Error.Class
(MonadError) (MonadError, throwError)
import Control.Monad.IO.Class import Control.Monad.IO.Class
(MonadIO) (MonadIO)
import Control.Monad.Trans.Control import Control.Monad.Trans.Control
(MonadBaseControl (..)) (MonadBaseControl (..))
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
(ExceptT, runExceptT) (ExceptT, runExceptT)
import Data.String
(fromString)
import GHC.Generics import GHC.Generics
(Generic) (Generic)
import Servant.Server.Internal.ServerError import Servant.Server.Internal.ServerError
(ServerError) (ServerError, errBody, err500)
newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a } newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
deriving deriving
@ -32,6 +34,9 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
, MonadThrow, MonadCatch, MonadMask , MonadThrow, MonadCatch, MonadMask
) )
instance MonadFail Handler where
fail str = throwError err500 { errBody = fromString str }
instance MonadBase IO Handler where instance MonadBase IO Handler where
liftBase = Handler . liftBase liftBase = Handler . liftBase